如何通过Excel新的“放置在单元格中”功能获取放置在单元格中的图片的名称

Question

这里和其他地方有几篇文章应该回答这个问题：“如何通过 Excel 的新‘放置在单元格中’功能获取放置在单元格中的图片的名称？”这显然与“Picture.Insert(path)”方法不同。

建议的两种方法（如下面的代码所示）都没有透露任何内容。其中可能存在一些小错误，但它们已被更改多次以尝试图片的名称或存在。

显然，当图片放置在单元格上方时，此代码可能会起作用。然而，每次发生这种情况时，名称都会更改为“图片##”之类的内容。我想计算所有插入的图像并获得一个静态名称（或者至少是它存在于单元格中的证据。）

仅供参考，运行代码时工作表不受保护。

Public Function GetPictureName() As String
' Return the name of the Picture in the current cell
Dim shp As Shape

    GetPictureName = vbNullString

    For Each shp In ActiveSheet.Shapes
        If shp.TopLeftCell.address = ActiveCell.address Then
            GetPictureName = shp.Name
        End If
    Next

End Function


Public Function Is_PictureInCell() As Boolean
' Is there a picture in the current cell
Dim pic As Picture

    Is_PictureInCell = False

    For Each pic In Sheets(1).Pictures
        If pic.TopLeftCell.address = ActiveCell.address Then Is_PictureInCell = True
        If InStr(1, pic.Name, "Picture") > 0 Then Debug.Print pic.Name
    Next
    
End Function

这两个功能都已更改为查找“图片”和“形状”，但当图片位于单元格中时没有成功。虽然我可以使用“旧”插入方法，但我正在尝试使用 Office 365 功能来确保我的代码面向未来。

Answer 1

Excel对象模型中似乎还没有单元格图片对象。它不是形状或图片集合的一部分。

这是一个解决方案。它可能并不完美，但希望它能提供一些有用的想法。

Sub Demo()
    Dim c As Range
    Set c = Range("A1")
    Debug.Print IIf(HasPicInCell(c), "Found", "No") & " pic-in-cell in " & c.Address
End Sub

' Argument rCell is a single cell, modify as needed
Function HasPicInCell(rCell As Range) As Boolean
    Dim ShpCnt As Long, Sht As Worksheet
    Set Sht = rCell.Parent
    ShpCnt = Sht.Shapes.Count
    ' pic in cell >> pic over cells
    rCell.PlacePictureOverCells
    If Sht.Shapes.Count = 0 Then
        HasPicInCell = False
    Else
        HasPicInCell = (ShpCnt < Sht.Shapes.Count)
        ' get the converted pic
        Dim Shp: Set Shp = Sht.Shapes(Sht.Shapes.Count)
        ' Excel 365 [Version 2411 (Build 18210.20000)] crashes without the following line.
        ' I'm not sure if this is a bug in the version or an issue with my PC.
        ActiveCell.Select
        ' ***
        Shp.Select
        ' pic over cells >> pic in cell
        Shp.PlacePictureInCell
    End If
End Function