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

Excel VBA自定义函数从URL故障插入图像

1 个答案: