zenhuman
zenhuman

Reputation: 59

Excel VBA Custom Function Insert Image from URL glitch

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

Answers (1)

Kevin Pope
Kevin Pope

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

Related Questions