Excel VBA自定义function从URL毛刺插入图像

我是在VBA中创build函数的新手。 以下代码是对此处find的脚本的修改。 该代码将两个图像从URL（或从文件系统）插入Excel电子表格中的两个用户定义的范围。 在目标工作表中，我有一个公式引用同一工作簿中源表单中的包含url的单元格。 代码的工作方式应该是在自己的工作表上，但是当我在源表单上工作时，它还会在保存文档或复制/粘贴时将图像插入到源表单中。 在告诉Excel只贴在目标表单上的时候，如何保持一般的function呢？ 如何在每次保存或复制/粘贴时重新计算代码？ 谢谢！ 禅

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

无论何时重新计算工作表，该function都将运行，在您处理工作表时会频繁发生。 当你在那里工作的时候，把图片放在源代码表中，因为你将p1和p2对象设置为ActiveSheet 。

试试这些：

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

和

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

您可能还需要将计算设置为手动，以便每次更改单元格值时都不会删除并重新插入图像：

 Application.Calculation = xlCalculationManual