Excel VBA自定义功能从URL故障中插入图像

Question

我是在VBA中创建函数的新手。以下代码是对脚本here的修改。该代码将两个图像从URL（或从文件系统）插入Excel电子表格中的两个用户定义的范围。在目标工作表中，我有一个公式可以引用同一工作簿中源表单中包含URL的单元格。代码在它自己的工作表上工作，但是，当我在源表单上工作时，它还会在保存文档或复制/粘贴时将图像插入到源表单中。在告诉Excel仅粘贴到目标工作表上时，如何保留常规功能？如何在每次保存或复制/粘贴时重新计算代码？谢谢！每当你重新计算表，当你做这个工作，这将频繁发生禅

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 

Answer 1

，函数就会运行。当您在那里工作时，它会将图像放在源表单上，因为您将p1和p2对象设置为ActiveSheet。

尝试这些替代：

Set p1 = ThisWorkbook.Worksheets(TargetSheet).Pictures.Insert(URL1) 

和

Set p2 = ThisWorkbook.Worksheets(TargetSheet).Pictures.Insert(URL2) 

您可能还需要设置计算手册，这样你就不会删除并重新插入图像每次更改单元格值：

Application.Calculation = xlCalculationManual