如何在VBA中嵌入图片至Excel文件，确保客户可正常查看

你的问题出在插入图片的方式上：Pictures.Insert是链接形式插入图片，Excel只保存图片的本地路径，客户电脑没有对应路径的原图就无法显示。要改成嵌入图片，只需要替换插入图片的代码逻辑，让图片直接存入Excel文件中。

修改后的完整VBA代码如下：

Sub INSERT_PIC()
    Dim MyMergeCell As Range
    Dim MyFile As Variant
    Dim targetShape As Shape
    Dim targetRange As Range
    
    '- 选中目标合并单元格
    Set MyMergeCell = ActiveCell
    Set targetRange = MyMergeCell.MergeArea
    
    '- 选择图片文件
    MyFile = Application.GetOpenFilename( _
        FileFilter:="Picture Files (*.bmp;*.jpg;*.tif;*.gif), *.bmp;*.jpg;*.tif;*.gif", _
        Title:="选择图片", _
        MultiSelect:=False)
    If MyFile = False Then Exit Sub
    
    '- 嵌入图片到工作表（关键改动：用AddPicture并设置嵌入参数）
    Set targetShape = ActiveSheet.Shapes.AddPicture( _
        Filename:=MyFile, _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoTrue, _
        Left:=targetRange.Left, _
        Top:=targetRange.Top, _
        Width:=targetRange.Width, _
        Height:=targetRange.Height)
    
    '- 保持图片比例并适配单元格
    targetShape.LockAspectRatio = msoTrue
    Select Case (targetRange.Width / targetRange.Height) / (targetShape.Width / targetShape.Height)
        Case Is > 1
            targetShape.Height = targetRange.Height
        Case Else
            targetShape.Width = targetRange.Width
    End Select
    '- 对齐单元格位置
    targetShape.Top = targetRange.Top
    targetShape.Left = targetRange.Left
End Sub

关键改动说明： #

• 用Shapes.AddPicture替代Pictures.Insert，并设置两个核心参数：
  • LinkToFile:=msoFalse：不创建图片文件的链接
  • SaveWithDocument:=msoTrue：将图片嵌入并随Excel文件一起保存
• 直接获取插入后的Shape对象，避免用Selection操作，代码更稳定高效
• 提前获取目标合并单元格区域，减少重复调用

修改后插入的图片会直接嵌入Excel文件，客户下载打开后就能正常查看，不需要依赖本地图片路径。

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