R
Roninn75
hi good da
i am trying to call images from a local drive into excel using
validation list. i have found the following procedure from Ron Coderr
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 The
InsertPicFromFile
strFileLoc:=Range("rngFileLocation").Value,
rDestCells:=Range("rngPicDisplayCells"),
blnFitInDestHeight:=True,
strPicName:="MyDVPic
End I
End Su
-------------------
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 a
using 2010
any assistance is highly appreciate
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 Shap
Dim shtWS As Workshee
Set shtWS = rDestCells.Paren
On Error Resume Nex
'Delete the named picture (if it already exists
shtWS.Shapes(strPicName).Delet
On Error Resume Nex
With rDestCell
'Create the new pictur
'(arbitrarily sized as a square that i
'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 siz
oNewPic.LockAspectRatio = msoTru
oNewPic.ScaleHeight Factor:=1,
RelativeToOriginalSize:=msoTru
oNewPic.ScaleWidth Factor:=1,
RelativeToOriginalSize:=msoTru
If blnFitInDestHeight = True The
'Resize picture to fit destination cell
oNewPic.Height = .Height -
End I
'Assign the desired name to the pictur
oNewPic.Name = strPicNam
End With 'rCellDes
End Su
i am trying to call images from a local drive into excel using
validation list. i have found the following procedure from Ron Coderr
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 The
InsertPicFromFile
strFileLoc:=Range("rngFileLocation").Value,
rDestCells:=Range("rngPicDisplayCells"),
blnFitInDestHeight:=True,
strPicName:="MyDVPic
End I
End Su
-------------------
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 a
using 2010
any assistance is highly appreciate
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 Shap
Dim shtWS As Workshee
Set shtWS = rDestCells.Paren
On Error Resume Nex
'Delete the named picture (if it already exists
shtWS.Shapes(strPicName).Delet
On Error Resume Nex
With rDestCell
'Create the new pictur
'(arbitrarily sized as a square that i
'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 siz
oNewPic.LockAspectRatio = msoTru
oNewPic.ScaleHeight Factor:=1,
RelativeToOriginalSize:=msoTru
oNewPic.ScaleWidth Factor:=1,
RelativeToOriginalSize:=msoTru
If blnFitInDestHeight = True The
'Resize picture to fit destination cell
oNewPic.Height = .Height -
End I
'Assign the desired name to the pictur
oNewPic.Name = strPicNam
End With 'rCellDes
End Su