This routine needs this, too:
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub
davesexcel wrote:
Sub testme01()
Dim myPictureName As Variant
Dim myPict As Picture
Dim myRng As Range
Dim myCurFolder As String
Dim myNewFolder As String
myCurFolder = CurDir
myNewFolder = "yourfoldernamehere"
On Error Resume Next
ChDirNet myNewFolder
If Err.Number < 0 Then
'what should happen
MsgBox "Please change to your own folder"
Err.Clear
End If
On Error GoTo 0
myPictureName = Application.GetOpenFilename _
(filefilter:="Picture
Files,*.jpg;*.bmp;*.tif;*.gif")
ChDirNet myCurFolder
If myPictureName = False Then
Exit Sub 'user hit cancel
End If
Set myRng = Selection.Areas(1)
Set myPict = myRng.Parent.Pictures.Insert(myPictureName)
myPict.Top = myRng.Top
myPict.Width = myRng.Width
myPict.Height = myRng.Height
myPict.Left = myRng.Left
myPict.Placement = xlMoveAndSize
End Sub
Make a button for the Macro
when you click on the button you will be asked to choose the directory
and file you want to insert
whatever you insert will be inserted into what ever range you have
activated
--
davesexcel
------------------------------------------------------------------------
davesexcel's Profile: http://www.excelforum.com/member.php...o&userid=31708
View this thread: http://www.excelforum.com/showthread...hreadid=516640
--
Dave Peterson