0

我刚开始使用 VBA，如果有人能帮助我，我将不胜感激。我想根据存储在数据库中的路径查看图像。如果特定单元格中的值发生更改，图像应刷新。我已经想出了如何根据数据库导入一张图像，该数据库通过 INDEX 和 MATCH 公式连接到该特定单元格。不幸的是，我的知识不足以编写允许同时导入多个图像的代码。此外，有时以前的图像似乎不会被删除，并且新图像会在旧图像之上导入。如果数据库中根本没有图像或没有匹配的路径，则会出现运行时错误。

是否有可能为我的问题找到一个干净的解决方案并同时导入多个图像？如果有人能引导我走向正确的方向并至少帮助我处理运行时错误，我将非常感激。非常感谢提前！

数据库： 数据库

显示 + 特定单元格（红色）： 显示

用于导入第一张图片的代码：

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$CG$1" Then
    Shapes(1).Delete
    Pictures.Insert(ActiveSheet.Range("V21").Value).Select
    With Selection
        .Height = ActiveSheet.Range("V21:CI40").Height
        .Width = ActiveSheet.Range("V21:CI40").Width
        .Left = ActiveSheet.Range("V21").Left
        .Top = ActiveSheet.Range("V21").Top
    End With
    Range("C3").Select
End If
End Sub

ZIP 中的图像和 excel 文件的完整问题：

https://techcommunity.microsoft.com/t5/excel/vba-help-for-importing-images-from-file/mp/2181206

4

1 回答 1

1

尝试这个：

Option Explicit

Private Sub ScrollBar1_Change()
    Range("$CG$1").Value = Range("$CG$1").Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    
    'Checking the Target address.
    If Target.Address = "$CG$1" Then
        
        'Declarations.
        Dim ObjImageTop As Object
        Dim ObjImageBottom As Object
        Dim RngImageTop As Range
        Dim RngImageBottom As Range
        Dim StrImageTopName As String
        Dim StrImageBottomName As String
        Dim StrImageTopAddress As String
        Dim StrImageBottomAddress As String
        
        'Settings.
        StrImageTopName = "Img_Top"
        StrImageBottomName = "Img_Bottom"
        StrImageTopAddress = Sheets("Monitor").Range("V21").Value
        StrImageBottomAddress = Sheets("Monitor").Range("V42").Value
        Set RngImageTop = Sheets("Monitor").Range("V21:CI40")
        Set RngImageBottom = Sheets("Monitor").Range("V42:CI73")
        
        'Deleting the previous images.
        On Error Resume Next
        Sheets("Monitor").Shapes(StrImageTopName).Delete
        Sheets("Monitor").Shapes(StrImageBottomName).Delete
        Err = 0
        On Error GoTo 0
        
        'Inserting the new ObjImageTop.
        Set ObjImageTop = Sheets("Monitor").Pictures.Insert(StrImageTopAddress)
        With ObjImageTop
            .Name = StrImageTopName
            .Height = RngImageTop.Height
            .Width = RngImageTop.Width
            .Left = RngImageTop.Left
            .Top = RngImageTop.Top
        End With
        
        'Inserting the new ObjImageBottom.
        Set ObjImageTop = Sheets("Monitor").Pictures.Insert(Sheets("Monitor").Range("V42").Value)
        With ObjImageTop
            .Name = StrImageBottomName
            .Height = RngImageBottom.Height
            .Width = RngImageBottom.Width
            .Left = RngImageBottom.Left
            .Top = RngImageBottom.Top
        End With
    
    End If
    
End Sub

确保如果您通过滚动条Private Sub ScrollBar1_Change()更改数字，它将激活 Worksheet_Change 事件。Option Explicit是可选的（关于它的更多信息在这里）。在该'Setting部分中，您可以对其进行自定义。您可以更改将赋予图像的名称、它们的地址以及它们将被放置的范围。您也不能依赖这些单元格（V21 和 V42），而是在代码本身中确定您的地址。

于 2021-03-03T11:47:21.103 回答