Reputation: 59
I'm new to creating functions in VBA. The following code is a modification of a script found here. The code inserts two images from urls (or from the file system) into two user-defined ranges in an Excel spreadsheet. In a target sheet, I've got a formula that references a URL-containing cell in a source sheet in the same workbook. The code works as it should on its own sheet, but, when I'm working on the source sheet, it also inserts the images onto the source sheet when I either Save the document or Copy/Paste. How do I keep the function general while telling Excel only to paste on the target sheet? How do I keep the code from recalculating on every Save or Copy/Paste? Thanks! Zen
Public Function NewPicsToRanges(URL1 As String, URL2 As String, Optional TargetCells1 As Range, Optional TargetCells2 As Range)
' inserts a picture and resizes it to fit the TargetCells range
ActiveSheet.Shapes.SelectAll
Selection.Delete
Dim p1 As Object, t1 As Double, l1 As Double, w1 As Double, h1 As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Function
'If Dir(URL1) = "" Then Exit Function
' import picture
Set p1 = ActiveSheet.Pictures.Insert(URL1)
' determine positions
With TargetCells1
t1 = .Top
l1 = .Left
w1 = .Offset(0, .Columns.Count).Left - .Left
h1 = .Offset(.Rows.Count, 0).Top - .Top
End With
' position picture
With p1
.Top = t1
.Left = l1
.Width = w1
.Height = h1
End With
Set p1 = Nothing
Dim p2 As Object, t2 As Double, l2 As Double, w2 As Double, h2 As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Function
'If Dir(URL2) = "" Then Exit Function
' import picture
Set p2 = ActiveSheet.Pictures.Insert(URL2)
' determine positions
With TargetCells2
t2 = .Top
l2 = .Left
w2 = .Offset(0, .Columns.Count).Left - .Left
h2 = .Offset(.Rows.Count, 0).Top - .Top
End With
' position picture
With p2
.Top = t2
.Left = l2
.Width = w2
.Height = h2
End With
Set p2 = Nothing
End Function
Upvotes: 2
Views: 3538
Reputation: 2982
The function will run whenever you recalculate the sheet, which will happen frequently when you're working on it. It's putting the images on the source sheet when you're working there because you're setting the p1
and p2
objects to ActiveSheet
.
Try these instead:
Set p1 = ThisWorkbook.Worksheets(TargetSheet).Pictures.Insert(URL1)
and
Set p2 = ThisWorkbook.Worksheets(TargetSheet).Pictures.Insert(URL2)
You may also want to set calculation to manual so that you won't remove and re-insert the images every time you change a cell value:
Application.Calculation = xlCalculationManual
Upvotes: 1