VBA根据单元格值动态插入图像，如果单元格为空，则不做任何操作

Question

我在单元格(fom I11 to I19)中有一个动态图像语句，我通常只使用2或3行，所以其他7-8行是空的。我的宏命令在填充的单元格中运行良好，但对于空单元格，它还插入了一个图像，该图像显示“链接的图像无法显示”。如果单元格D11到D19是空的，我希望VBA不要插入图像。此外，要运行命令，我必须单击developer选项卡和宏，这可以自动化(D列有数据验证)吗？谢谢

Sub Insert_Multiple_Images()

Set Image_Names = Range("D11:D19")
Image_Location = "C:\Image"
Image_Format = ".png"

Set Cell_Reference = Range("I11:I19")

For i = 1 To Image_Names.Rows.Count
    For j = 1 To Image_Names.Columns.Count
        Set Image = ActiveSheet.Pictures.Insert(Image_Location + "\" + Image_Names.Cells(i, j) + Image_Format)
        Image.Top = Cell_Reference.Cells(i, j).Top
        Image.Left = Cell_Reference.Cells(i, j).Left
        Image.ShapeRange.Height = 45
        Image.ShapeRange.Width = 75
    Next j
Next i

End Sub

Answer 1

请使用下一个解决方案。您没有回答澄清问题，因此如果"D11:D19“范围内的任何单元格发生更改，则该单元格将自动运行。代码检查对应单元格("I & modified行“)上是否存在图片，将其删除。如果修改后单元格为空，则代码不会执行任何操作：

请复制处理代码模块所需的工作表中的下一个代码(右键单击工作表名称并选择View Code)：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Image_Names As Range

    Set Image_Names = Range("D11:D19")
    If Not Intersect(Image_Names, Target) Is Nothing Then
        Dim Image_Location As String, Image_Format As String, i As Long, Image As Object
        Image_Location = "C:\Image"
        Image_Format = ".png"
        
        If Target.value <> "" Then 'if the changed cell is not empty:
                'check if picture exists:
                If Dir(Image_Location & "\" & Target.value & Image_Format) <> "" Then
                    'if picture already exists, delete it:
                    deletePicture Target.Offset(, 5).Address
                    
                    Set Image = Me.Pictures.Insert(Image_Location & "\" & Target.value & Image_Format)
                    Image.top = Target.Offset(, 5).top: Image.left = Target.Offset(, 5).left
                    
                    Image.ShapeRange.height = 45: Image.ShapeRange.width = 75
                Else
                    MsgBox "No picture exists on path """ & Image_Location & "\" & Target.value & Image_Format
                End If
        Else
            'if picture already exists, delete it:
            deletePicture Target.Offset(, 5).Address
       End if
    End If
End Sub

Sub deletePicture(rngAddr As String)
    Dim sh As Shape
    
    For Each sh In Me.Shapes
        If sh.Type = 11 Then 'to process only the necessary pictures...
            If sh.TopLeftCell.Address = rngAddr Then sh.Delete: Exit For
        End If
    Next sh
End Sub

请在测试后发送一些反馈信息。

代码可以像您的代码一样处理所有的范围，但是由于在范围的其余部分没有任何更改，所以我认为这只是Excel浪费资源。

Answer 2

可以尝试对D列和第一列中使用的最后一行使用动态范围，并匹配这两个范围。

dim lRowD作为整数

lRowD =工作表(1).Cells(Rows.Count，4).End(xlUp).Row

‘更新这些行’设置为Image_Names = Range("D11:D“& lRowD)集Cell_Reference = Range("I11:I”& lRowD)

此外，还可以插入->形状，右键单击形状上的菜单并分配一个宏，而不是转到developer选项卡。