如何读取通过Shapes.AddPicture添加的Shape中的图片文件？

你用AddPicture并设置linktofile:=msoFalse时，图片是嵌入到Excel文档中的，并非链接原文件，所以Shape对象没有直接属性能获取原文件的路径。下面是两种可行的处理方案：

方案1：提前记录原文件路径（推荐） #

在添加图片时，把原文件路径存储到Shape的属性里，后续直接读取即可。修改你的原函数：

Private Function attachImageMac(ByVal FName As String, ByVal imageName As String)
    Dim img As Shape
    Dim imgWidth, imgHeight As Long
    
    imgWidth = -1
    imgHeight = -1
    
    Set img = Sheets("Receipt images").Shapes.AddPicture(fileName:=FName, linktofile:=msoFalse, _
        savewithdocument:=msoCTrue, Left:=10, top:=10, width:=imgWidth, height:=imgHeight)
    img.Name = imageName
    img.LockAspectRatio = msoTrue
    ' 把原文件路径存入Shape的备用文本属性
    img.AlternativeText = FName
    Set img = Nothing 
End Function

后续要访问原文件（如果文件仍存在），直接读取该属性：

Dim targetShape As Shape
Set targetShape = Sheets("Receipt images").Shapes("你的图片名称")
' 获取原文件路径
Dim originalFilePath As String
originalFilePath = targetShape.AlternativeText
' 可以用Shell或其他方式打开文件
If Dir(originalFilePath) <> "" Then
    Shell "explorer.exe """ & originalFilePath & """", vbNormalFocus
End If

方案2：从Shape中导出嵌入的图片 #

如果原文件已经不存在，你可以把嵌入的图片重新导出为文件：

Sub ExportEmbeddedImage(ByVal shapeName As String, ByVal savePath As String)
    Dim targetShape As Shape
    Set targetShape = Sheets("Receipt images").Shapes(shapeName)
    
    ' 复制图片到剪贴板
    targetShape.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    
    ' 创建临时工作表
    Dim tempSheet As Worksheet
    Set tempSheet = ThisWorkbook.Sheets.Add
    tempSheet.Paste
    
    ' 导出图片
    tempSheet.Shapes(1).Export savePath, pbPNG ' 可替换为pbJPG等格式
    
    ' 删除临时工作表
    Application.DisplayAlerts = False
    tempSheet.Delete
    Application.DisplayAlerts = True
End Sub

调用示例：

ExportEmbeddedImage "你的图片名称", "C:\导出的图片.png"

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