insert picture in a range

[damorrison]

Hi Dave,
Using this macro, how can I insert the picture in a range say- A36:G44,
I have been fooling around with the Set myRng = ActiveCell line but
can't seem to get the proper syntax
Dave


2. Dave Peterson
Nov 14 2005, 5:27 am show options
Newsgroups: microsoft.public.excel
From: Dave Peterson <[email protected]> - Find messages by this
author
Date: Mon, 14 Nov 2005 06:27:16 -0600
Local: Mon, Nov 14 2005 5:27 am
Subject: Re: insert picture
Reply to Author | Forward | Print | Individual Message | Show original
| Report Abuse

Maybe you could give the user a macro to insert the picture. Then
you'll have
more control over what happens:

Option Explicit
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
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 = ActiveCell
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

 

[Dave Peterson]

I copied your code and fixed the line wrap problems and it worked perfectly for
me.

It put the picture right over the activecell.

Did you mean the multiple cells (maybe the current selection???). If you did,
then try this:

Set myRng = ActiveCell
becomes
Set myRng = selection.areas(1)

(Just in case you have multiple areas currently selected.)

 

[damorrison]

That's it!
Thanks again
Dave

 

[mathieu]

Hello mr. Peterson,

I just copied your macro and everything goes allright, untill one of the
last lines: lReturn=SetCurrent DirectoryA (szPath). The error says: 'Can't
find the directory'.
What can I do about it.

Thank you anyway.

Mathieu Borms

 

[mathieu]

Hello Mr. Peterson,

I just copied your macro, but I have a problem in one of the last lines:

 

[mathieu]

Hello mr. Peterson,

I just copied your macro and everything goes allright, untill one of the
last lines: lReturn=SetCurrent DirectoryA (szPath). The error says: 'Can't
find the directory'.
What can I do about it.

Thank you anyway.

Mathieu Borms

Problem solved. Thanx

 

[damorrison]

That's stange, because the code is supposed to let you find the
directory, there are two codes for this you may be just having copy and
paste problems, here it is again

Option Explicit
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 If
End Sub
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 = ActiveCell
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