|
Insert Picture Macro
In a portion of a macro, I would like the macro to open Insert Picture
dialog box and then go to a particular folder - I can get the macro to open to the My Pictures folder but then I would have to ask user to select a different folder - I would prefer that the macro selected the folder. The macro I am using is: dlgAnswer = Application.Dialogs(xlDialogInsertPicture).Show Much thanks. |
Insert Picture Macro
You could get the filename yourself:
Option Explicit Sub testme02() Dim myPictureName As Variant Dim myCurFolder As String Dim myNewFolder As String myCurFolder = CurDir myNewFolder = "C:\my documents\excel" ChDrive myNewFolder ChDir myNewFolder myPictureName = Application.GetOpenFilename _ (filefilter:="Picture Files,*.jpg;*.bmp;*.tif;*.gif") ChDrive myCurFolder ChDir myCurFolder If myPictureName = False Then Exit Sub 'user hit cancel End If 'do the real work End Sub SamDev wrote: In a portion of a macro, I would like the macro to open Insert Picture dialog box and then go to a particular folder - I can get the macro to open to the My Pictures folder but then I would have to ask user to select a different folder - I would prefer that the macro selected the folder. The macro I am using is: dlgAnswer = Application.Dialogs(xlDialogInsertPicture).Show Much thanks. -- Dave Peterson |
Insert Picture Macro
Dave:
It works except..... I have other code for resizing etc for the picture and I get error messages.... The following is my code - the issue is the code "Selection.ShapeRange.IncrementTop 13" - see complete code below. I don't know if rest of the code is OK because of the error I get at the Selection.ShapeRange.IncrementTop 13 line. Much thanks! Dim myPictureName As Variant Dim myCurFolder As String Dim myNewFolder As String myCurFolder = CurDir myNewFolder = "C:\my documents\excel" ChDrive myNewFolder ChDir myNewFolder myPictureName = Application.GetOpenFilename _ (filefilter:="Picture Files,*.jpg;*.bmp;*.tif;*.gif") ChDrive myCurFolder ChDir myCurFolder If myPictureName = False Then Exit Sub 'user hit cancel End If Dim Center1, Center2 As Double Selection.Name = ImgName Selection.ShapeRange.IncrementTop 13 Selection.ShapeRange.LockAspectRatio = True Selection.Locked = False If Selection.ShapeRange.Height < Selection.ShapeRange.Width Then Selection.ShapeRange.Width = 410# If Selection.ShapeRange.Height 305# Then Selection.ShapeRange.Height = 288# Center1 = (419 - Selection.ShapeRange.Width) / 2 Selection.ShapeRange.IncrementLeft Center1 Center2 = (306 - Selection.ShapeRange.Height) / 2 If Center1 < Center2 Then Center2 = Center1 Selection.ShapeRange.IncrementTop Center2 Else Wrng = MsgBox("This is a Verticle picture - do you want to set it to 4 inches tall?", _ vbYesNo, "Warning!") If Wrng = 7 Then Selection.ShapeRange.Delete Else Selection.ShapeRange.Height = 305# Center1 = (418 - Selection.ShapeRange.Width) / 2 Selection.ShapeRange.IncrementLeft Center1 Center2 = (306 - Selection.ShapeRange.Height) / 2 If Center1 < Center2 Then Center2 = Center1 Selection.ShapeRange.IncrementTop Center2 End If End If End Sub "Dave Peterson" wrote in message ... You could get the filename yourself: Option Explicit Sub testme02() Dim myPictureName As Variant Dim myCurFolder As String Dim myNewFolder As String myCurFolder = CurDir myNewFolder = "C:\my documents\excel" ChDrive myNewFolder ChDir myNewFolder myPictureName = Application.GetOpenFilename _ (filefilter:="Picture Files,*.jpg;*.bmp;*.tif;*.gif") ChDrive myCurFolder ChDir myCurFolder If myPictureName = False Then Exit Sub 'user hit cancel End If 'do the real work End Sub SamDev wrote: In a portion of a macro, I would like the macro to open Insert Picture dialog box and then go to a particular folder - I can get the macro to open to the My Pictures folder but then I would have to ask user to select a different folder - I would prefer that the macro selected the folder. The macro I am using is: dlgAnswer = Application.Dialogs(xlDialogInsertPicture).Show Much thanks. -- Dave Peterson |
Insert Picture Macro
Oops forgot to mention that the code below worked fine in my original code
that only opened the Insert Picture dialog box to the My Pictures folder. "SamDev" wrote in message ... Dave: It works except..... I have other code for resizing etc for the picture and I get error messages.... The following is my code - the issue is the code "Selection.ShapeRange.IncrementTop 13" - see complete code below. I don't know if rest of the code is OK because of the error I get at the Selection.ShapeRange.IncrementTop 13 line. Much thanks! Dim myPictureName As Variant Dim myCurFolder As String Dim myNewFolder As String myCurFolder = CurDir myNewFolder = "C:\my documents\excel" ChDrive myNewFolder ChDir myNewFolder myPictureName = Application.GetOpenFilename _ (filefilter:="Picture Files,*.jpg;*.bmp;*.tif;*.gif") ChDrive myCurFolder ChDir myCurFolder If myPictureName = False Then Exit Sub 'user hit cancel End If Dim Center1, Center2 As Double Selection.Name = ImgName Selection.ShapeRange.IncrementTop 13 Selection.ShapeRange.LockAspectRatio = True Selection.Locked = False If Selection.ShapeRange.Height < Selection.ShapeRange.Width Then Selection.ShapeRange.Width = 410# If Selection.ShapeRange.Height 305# Then Selection.ShapeRange.Height = 288# Center1 = (419 - Selection.ShapeRange.Width) / 2 Selection.ShapeRange.IncrementLeft Center1 Center2 = (306 - Selection.ShapeRange.Height) / 2 If Center1 < Center2 Then Center2 = Center1 Selection.ShapeRange.IncrementTop Center2 Else Wrng = MsgBox("This is a Verticle picture - do you want to set it to 4 inches tall?", _ vbYesNo, "Warning!") If Wrng = 7 Then Selection.ShapeRange.Delete Else Selection.ShapeRange.Height = 305# Center1 = (418 - Selection.ShapeRange.Width) / 2 Selection.ShapeRange.IncrementLeft Center1 Center2 = (306 - Selection.ShapeRange.Height) / 2 If Center1 < Center2 Then Center2 = Center1 Selection.ShapeRange.IncrementTop Center2 End If End If End Sub "Dave Peterson" wrote in message ... You could get the filename yourself: Option Explicit Sub testme02() Dim myPictureName As Variant Dim myCurFolder As String Dim myNewFolder As String myCurFolder = CurDir myNewFolder = "C:\my documents\excel" ChDrive myNewFolder ChDir myNewFolder myPictureName = Application.GetOpenFilename _ (filefilter:="Picture Files,*.jpg;*.bmp;*.tif;*.gif") ChDrive myCurFolder ChDir myCurFolder If myPictureName = False Then Exit Sub 'user hit cancel End If 'do the real work End Sub SamDev wrote: In a portion of a macro, I would like the macro to open Insert Picture dialog box and then go to a particular folder - I can get the macro to open to the My Pictures folder but then I would have to ask user to select a different folder - I would prefer that the macro selected the folder. The macro I am using is: dlgAnswer = Application.Dialogs(xlDialogInsertPicture).Show Much thanks. -- Dave Peterson |
Insert Picture Macro
You have to actually do your own inserting of the picture.
I think I'd rather just put the picture in a set range: Option Explicit Sub testme02() Dim myPictureName As Variant Dim myPict As Picture Dim myRng As Range Dim myCurFolder As String Dim myNewFolder As String myCurFolder = CurDir myNewFolder = "C:\my documents\excel" ChDrive myNewFolder ChDir myNewFolder myPictureName = Application.GetOpenFilename _ (filefilter:="Picture Files,*.jpg;*.bmp;*.tif;*.gif") ChDrive myCurFolder ChDir myCurFolder If myPictureName = False Then Exit Sub 'user hit cancel End If With Worksheets("sheet1") Set myRng = .Range("A1:c5") Set myPict = .Pictures.Insert(myPictureName) myPict.Top = myRng.Top myPict.Width = myRng.Width myPict.Height = myRng.Height myPict.Left = myRng.Left myPict.Placement = xlMoveAndSize End With End Sub SamDev wrote: Dave: It works except..... I have other code for resizing etc for the picture and I get error messages.... The following is my code - the issue is the code "Selection.ShapeRange.IncrementTop 13" - see complete code below. I don't know if rest of the code is OK because of the error I get at the Selection.ShapeRange.IncrementTop 13 line. Much thanks! Dim myPictureName As Variant Dim myCurFolder As String Dim myNewFolder As String myCurFolder = CurDir myNewFolder = "C:\my documents\excel" ChDrive myNewFolder ChDir myNewFolder myPictureName = Application.GetOpenFilename _ (filefilter:="Picture Files,*.jpg;*.bmp;*.tif;*.gif") ChDrive myCurFolder ChDir myCurFolder If myPictureName = False Then Exit Sub 'user hit cancel End If Dim Center1, Center2 As Double Selection.Name = ImgName Selection.ShapeRange.IncrementTop 13 Selection.ShapeRange.LockAspectRatio = True Selection.Locked = False If Selection.ShapeRange.Height < Selection.ShapeRange.Width Then Selection.ShapeRange.Width = 410# If Selection.ShapeRange.Height 305# Then Selection.ShapeRange.Height = 288# Center1 = (419 - Selection.ShapeRange.Width) / 2 Selection.ShapeRange.IncrementLeft Center1 Center2 = (306 - Selection.ShapeRange.Height) / 2 If Center1 < Center2 Then Center2 = Center1 Selection.ShapeRange.IncrementTop Center2 Else Wrng = MsgBox("This is a Verticle picture - do you want to set it to 4 inches tall?", _ vbYesNo, "Warning!") If Wrng = 7 Then Selection.ShapeRange.Delete Else Selection.ShapeRange.Height = 305# Center1 = (418 - Selection.ShapeRange.Width) / 2 Selection.ShapeRange.IncrementLeft Center1 Center2 = (306 - Selection.ShapeRange.Height) / 2 If Center1 < Center2 Then Center2 = Center1 Selection.ShapeRange.IncrementTop Center2 End If End If End Sub "Dave Peterson" wrote in message ... You could get the filename yourself: Option Explicit Sub testme02() Dim myPictureName As Variant Dim myCurFolder As String Dim myNewFolder As String myCurFolder = CurDir myNewFolder = "C:\my documents\excel" ChDrive myNewFolder ChDir myNewFolder myPictureName = Application.GetOpenFilename _ (filefilter:="Picture Files,*.jpg;*.bmp;*.tif;*.gif") ChDrive myCurFolder ChDir myCurFolder If myPictureName = False Then Exit Sub 'user hit cancel End If 'do the real work End Sub SamDev wrote: In a portion of a macro, I would like the macro to open Insert Picture dialog box and then go to a particular folder - I can get the macro to open to the My Pictures folder but then I would have to ask user to select a different folder - I would prefer that the macro selected the folder. The macro I am using is: dlgAnswer = Application.Dialogs(xlDialogInsertPicture).Show Much thanks. -- Dave Peterson -- Dave Peterson |
Insert Picture Macro
Ok - much thanks - that makes sense!!
"Dave Peterson" wrote in message ... You have to actually do your own inserting of the picture. I think I'd rather just put the picture in a set range: Option Explicit Sub testme02() Dim myPictureName As Variant Dim myPict As Picture Dim myRng As Range Dim myCurFolder As String Dim myNewFolder As String myCurFolder = CurDir myNewFolder = "C:\my documents\excel" ChDrive myNewFolder ChDir myNewFolder myPictureName = Application.GetOpenFilename _ (filefilter:="Picture Files,*.jpg;*.bmp;*.tif;*.gif") ChDrive myCurFolder ChDir myCurFolder If myPictureName = False Then Exit Sub 'user hit cancel End If With Worksheets("sheet1") Set myRng = .Range("A1:c5") Set myPict = .Pictures.Insert(myPictureName) myPict.Top = myRng.Top myPict.Width = myRng.Width myPict.Height = myRng.Height myPict.Left = myRng.Left myPict.Placement = xlMoveAndSize End With End Sub SamDev wrote: Dave: It works except..... I have other code for resizing etc for the picture and I get error messages.... The following is my code - the issue is the code "Selection.ShapeRange.IncrementTop 13" - see complete code below. I don't know if rest of the code is OK because of the error I get at the Selection.ShapeRange.IncrementTop 13 line. Much thanks! Dim myPictureName As Variant Dim myCurFolder As String Dim myNewFolder As String myCurFolder = CurDir myNewFolder = "C:\my documents\excel" ChDrive myNewFolder ChDir myNewFolder myPictureName = Application.GetOpenFilename _ (filefilter:="Picture Files,*.jpg;*.bmp;*.tif;*.gif") ChDrive myCurFolder ChDir myCurFolder If myPictureName = False Then Exit Sub 'user hit cancel End If Dim Center1, Center2 As Double Selection.Name = ImgName Selection.ShapeRange.IncrementTop 13 Selection.ShapeRange.LockAspectRatio = True Selection.Locked = False If Selection.ShapeRange.Height < Selection.ShapeRange.Width Then Selection.ShapeRange.Width = 410# If Selection.ShapeRange.Height 305# Then Selection.ShapeRange.Height = 288# Center1 = (419 - Selection.ShapeRange.Width) / 2 Selection.ShapeRange.IncrementLeft Center1 Center2 = (306 - Selection.ShapeRange.Height) / 2 If Center1 < Center2 Then Center2 = Center1 Selection.ShapeRange.IncrementTop Center2 Else Wrng = MsgBox("This is a Verticle picture - do you want to set it to 4 inches tall?", _ vbYesNo, "Warning!") If Wrng = 7 Then Selection.ShapeRange.Delete Else Selection.ShapeRange.Height = 305# Center1 = (418 - Selection.ShapeRange.Width) / 2 Selection.ShapeRange.IncrementLeft Center1 Center2 = (306 - Selection.ShapeRange.Height) / 2 If Center1 < Center2 Then Center2 = Center1 Selection.ShapeRange.IncrementTop Center2 End If End If End Sub "Dave Peterson" wrote in message ... You could get the filename yourself: Option Explicit Sub testme02() Dim myPictureName As Variant Dim myCurFolder As String Dim myNewFolder As String myCurFolder = CurDir myNewFolder = "C:\my documents\excel" ChDrive myNewFolder ChDir myNewFolder myPictureName = Application.GetOpenFilename _ (filefilter:="Picture Files,*.jpg;*.bmp;*.tif;*.gif") ChDrive myCurFolder ChDir myCurFolder If myPictureName = False Then Exit Sub 'user hit cancel End If 'do the real work End Sub SamDev wrote: In a portion of a macro, I would like the macro to open Insert Picture dialog box and then go to a particular folder - I can get the macro to open to the My Pictures folder but then I would have to ask user to select a different folder - I would prefer that the macro selected the folder. The macro I am using is: dlgAnswer = Application.Dialogs(xlDialogInsertPicture).Show Much thanks. -- Dave Peterson -- Dave Peterson |
| All times are GMT +1. The time now is 11:06 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com