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