Excel VBA代码优化：排除指定图片避免被误删

方案1：排除指定名称的图片 #

遍历工作表所有形状，仅删除非指定名称的图片，保留pic__Flag、pic__Building、pic__Logo三张图片：

Sub CopyValuesAndPictures()
    ' 保留你原有宏的复制逻辑代码...
    
    ' --- 修改后的图片删除逻辑 ---
    Dim shp As Shape
    Dim excludeNames As Variant
    ' 定义需要保留的图片名称数组
    excludeNames = Array("pic__Flag", "pic__Building", "pic__Logo")
    
    For Each shp In ActiveSheet.Shapes
        ' 判断是否为图片，且名称不在保留列表中
        If shp.Type = msoPicture And IsError(Application.Match(shp.Name, excludeNames, 0)) Then
            shp.Delete
        End If
    Next shp
End Sub

关键说明： #

• excludeNames数组存储需要保留的图片名称，可根据需求调整
• msoPicture确保只处理图片类型的形状（避免误删文本框、图表等其他形状）
• Application.Match检查当前图片名称是否在保留列表中，返回错误则说明不在列表内，执行删除

方案2：仅删除指定区域内的图片 #

只删除I17:I范围内（从I17到I列最后一行有数据的单元格）的图片：

Sub CopyValuesAndPictures()
    ' 保留你原有宏的复制逻辑代码...
    
    ' --- 修改后的图片删除逻辑 ---
    Dim shp As Shape
    Dim targetRange As Range
    ' 动态获取I列从I17到最后一行有数据的区域
    Set targetRange = ActiveSheet.Range("I17:I" & ActiveSheet.Cells(ActiveSheet.Rows.Count, "I").End(xlUp).Row)
    
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoPicture Then
            ' 判断图片是否与目标区域相交（左上角或右下角单元格在区域内）
            If Not Intersect(shp.TopLeftCell, targetRange) Is Nothing Or _
               Not Intersect(shp.BottomRightCell, targetRange) Is Nothing Then
                shp.Delete
            End If
        End If
    Next shp
End Sub

关键说明： #

• 动态获取目标区域，避免硬编码行数，适配数据变化
• 通过TopLeftCell和BottomRightCell判断图片是否覆盖目标区域内的单元格，若需严格判断图片完全在区域内，可调整条件为图片的四个角单元格均在区域内

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