求Excel VBA代码判断单元格是否含嵌入图片及修改指定函数适配锁定图片

原有的两个函数在判断锁定于单元格内的图片时存在逻辑缺陷：仅通过形状区域与单元格的交集、或仅检查形状左上角单元格来判断，无法精准识别随单元格移动/调整大小的嵌入式图片。以下是修正后的函数：

修正后的IsPictureInCell函数 #

该函数会精准判断目标单元格是否包含锁定的嵌入图片（需满足图片类型为标准图片、且与单元格绑定）：

' 检查指定单元格中是否存在锁定的嵌入图片
Function IsPictureInCell(Cell As Range) As Boolean
    Dim shp As Shape
    ' 确保仅处理单个单元格
    If Cell.Cells.Count <> 1 Then Exit Function
    
    For Each shp In Cell.Parent.Shapes
        ' 仅处理图片类型的形状，排除其他形状（如文本框、图表）
        If shp.Type = msoPicture Then
            ' 判断图片是否与单元格绑定（随单元格移动/调整大小）
            Select Case shp.Placement
                Case xlMoveAndSize, xlMove
                    ' 检查图片的边界是否完全匹配目标单元格
                    If shp.TopLeftCell.Address = Cell.Address And _
                       shp.BottomRightCell.Address = Cell.Address Then
                        IsPictureInCell = True
                        Exit Function
                    End If
            End Select
        End If
    Next shp
End Function

修正后的CopyCellPictureToClipboard函数 #

该函数会找到单元格内锁定的图片并复制到剪贴板，同时优化了错误处理：

' 将单元格内锁定的嵌入图片复制到剪贴板，成功返回True，失败返回False
Function CopyCellPictureToClipboard(Cell As Range) As Boolean
    Dim shp As Shape
    ' 确保仅处理单个单元格
    If Cell.Cells.Count <> 1 Then Exit Function
    
    On Error GoTo Cleanup ' 替换On Error Resume Next，精准捕获错误
    For Each shp In Cell.Parent.Shapes
        If shp.Type = msoPicture Then
            Select Case shp.Placement
                Case xlMoveAndSize, xlMove
                    If shp.TopLeftCell.Address = Cell.Address And _
                       shp.BottomRightCell.Address = Cell.Address Then
                        shp.Copy
                        CopyCellPictureToClipboard = True
                        Exit Function
                    End If
            End Select
        End If
    Next shp

Cleanup:
    ' 若发生错误，返回False
    If Err.Number <> 0 Then CopyCellPictureToClipboard = False
End Function

关键修改说明 #

• 限定单元格范围：新增判断确保函数仅处理单个单元格，避免传入多单元格区域导致逻辑混乱
• 精准匹配图片类型：通过shp.Type = msoPicture过滤掉非图片形状（如文本框、形状图形）
• 检查绑定属性：通过shp.Placement判断图片是否与单元格绑定（xlMoveAndSize为随单元格移动并调整大小，xlMove为仅随单元格移动）
• 严格匹配单元格边界：通过对比图片的左上角和右下角单元格地址，确保图片完全属于目标单元格
• 优化错误处理：将On Error Resume Next替换为定向错误捕获，避免隐藏未知错误

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