images into excel
hi good day
i am trying to call images from a local drive into excel using a validation list. i have found the following procedure from Ron Coderre over at contextures.com which i am trying to adapt.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("rngDisplayName")) Is Nothing Then
InsertPicFromFile _
strFileLoc:=Range("rngFileLocation").Value, _
rDestCells:=Range("rngPicDisplayCells"), _
blnFitInDestHeight:=True, _
strPicName:="MyDVPic"
End If
End Sub
the last line (strPicName:="MyDVPic") kicks out an 1004 run time error - Range of object worksheet failed.
i think it has to do with the version it was written in, (2007) and i am using 2010.
any assistance is highly appreciated
this is the code for the module:
Code:
Sub InsertPicFromFile( _
strFileLoc As String, _
rDestCells As Range, _
blnFitInDestHeight As Boolean, _
strPicName As String)
Dim oNewPic As Shape
Dim shtWS As Worksheet
Set shtWS = rDestCells.Parent
On Error Resume Next
'Delete the named picture (if it already exists)
shtWS.Shapes(strPicName).Delete
On Error Resume Next
With rDestCells
'Create the new picture
'(arbitrarily sized as a square that is
'the height of the rDestCells)
Set oNewPic = shtWS.Shapes.AddPicture( _
filename:=strFileLoc, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=.Left + 1, Top:=.Top + 1, _
Width:=.Height - 1, Height:=.Height - 1)
'Maintain original aspect ratio, set to full size
oNewPic.LockAspectRatio = msoTrue
oNewPic.ScaleHeight Factor:=1, _
RelativeToOriginalSize:=msoTrue
oNewPic.ScaleWidth Factor:=1, _
RelativeToOriginalSize:=msoTrue
If blnFitInDestHeight = True Then
'Resize picture to fit destination cells
oNewPic.Height = .Height - 1
End If
'Assign the desired name to the picture
oNewPic.Name = strPicName
End With 'rCellDest
End Sub
|
