2

我是在 VBA 中创建函数的新手。以下代码是对此处找到的脚本的修改。该代码将两个来自 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
4

1 回答 1

1

每当您重新计算工作表时,该功能就会运行,这在您处理工作表时会经常发生。当您在那里工作时,它会将图像放在源表上,因为您将p1andp2对象设置为ActiveSheet.

试试这些:

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

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

您可能还希望将计算设置为手动,这样您就不会在每次更改单元格值时删除并重新插入图像:

Application.Calculation = xlCalculationManual
于 2012-11-03T05:56:58.397 回答