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