PPT宏导入图片时如何指定名称或避免重复添加相同图片？

有两种实用方法可以避免重复添加相同图片，直接上干货：

方法一：导入时指定固定名称，导入前先删除同名图片 #

你可以在导入图片后手动给它设置一个固定名称，每次运行宏时先检查幻灯片里有没有这个名称的形状，有就删掉再重新导入。

修改后的完整代码示例：

Sub 导入指定图片()
    Dim slide As slide
    Dim targetShape As Shape
    Dim imageFullPath As String
    Dim plot1 As Shape
    
    ' 设置目标幻灯片（这里假设是第1张，可按需修改索引）
    Set slide = ActivePresentation.Slides(1)
    imageFullPath = imagePath & "image.png" ' 你的图片完整路径
    
    ' 先删除已存在的同名图片
    For Each targetShape In slide.Shapes
        If targetShape.Name = "固定名称的图片" Then
            targetShape.Delete
            Exit For ' 找到目标后退出循环，避免无效遍历
        End If
    Next targetShape
    
    ' 重新导入图片并设置固定名称
    Set plot1 = slide.Shapes.AddPicture(imageFullPath, LinkToFile:=False, _
        SaveWithDocument:=True, Left:=100, Top:=100, Width:=180, Height:=160)
    plot1.Name = "固定名称的图片" ' 给图片设置固定标识名称
End Sub

方法二：根据图片的位置/尺寸特征删除旧图片 #

如果不想手动设置名称，也可以利用图片固定的位置坐标、尺寸参数来匹配旧图片并删除——毕竟你导入的图片位置和大小都是固定的：

代码示例：

Sub 导入图片并去重()
    Dim slide As slide
    Dim targetShape As Shape
    Dim imageFullPath As String
    Dim plot1 As Shape
    
    Set slide = ActivePresentation.Slides(1)
    imageFullPath = imagePath & "image.png"
    
    ' 根据位置和尺寸匹配删除旧图片
    For Each targetShape In slide.Shapes
        ' 先判断是否为图片，再匹配位置和尺寸
        If targetShape.Type = msoPicture Then
            If targetShape.Left = 100 And targetShape.Top = 100 _
                And targetShape.Width = 180 And targetShape.Height = 160 Then
                targetShape.Delete
                Exit For
            End If
        End If
    Next targetShape
    
    ' 导入图片
    Set plot1 = slide.Shapes.AddPicture(imageFullPath, LinkToFile:=False, _
        SaveWithDocument:=True, Left:=100, Top:=100, Width:=180, Height:=160)
End Sub

补充说明 #

• 方法一精准度更高，不会误删其他位置相同的图片；方法二更灵活，无需额外设置名称。
• 由于你的代码是嵌入图片而非链接，没法直接通过原路径判断，所以前两种方法是最优选择。

内容的提问来源于stack exchange，提问作者Elizabeth Michiko