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