Excel VBA如何正确引用并移动工作表内直接插入的BMP图片

问题说明 #

从Windows文件夹拖拽12张bmp格式图片到Excel工作表，原文件名依次为1 1.bmp、1 2.bmp、1 3.bmp……，图片与当前xlsm文件存放在同一目录下。需要将图片移动到工作表指定位置，以下两种引用写法均不生效：

' 写法1：用不带后缀的原文件名引用
Worksheets("R").Shapes("1 1").Top = Worksheets("R").Rows(24).Top
' 写法2：用带后缀的原文件名引用
Worksheets("R").Shapes("1 1.bmp").Top = Worksheets("R").Rows(24).Top

失效原因 #

拖拽插入到Excel工作表的图片，Shape对象的名称不会沿用原文件名，Excel会自动生成默认名称（中文环境为图片 1、图片 2这类格式，英文环境为Picture 1、Picture 2这类格式），用原文件名作为索引查询Shapes集合无法匹配到对应对象，因此代码不生效。

正确实现方案 #

方案1：按原文件名匹配定位 #

拖拽插入的图片默认会把原文件名保存在Shape对象的AlternativeText（可选文字）属性中，可以遍历Shapes集合匹配该属性找到对应图片：

Dim shp As Shape
For Each shp In Worksheets("R").Shapes
    ' 筛选图片类型+匹配原文件名
    If shp.Type = msoPicture And shp.AlternativeText = "1 1.bmp" Then
        shp.Top = Worksheets("R").Rows(24).Top
        ' 如需设置左对齐可追加：shp.Left = Worksheets("R").Columns(1).Left
        Exit For
    End If
Next

方案2：按插入顺序批量定位 #

如果12张图片是按文件名顺序依次拖拽插入，且工作表中没有其他Shape对象，可以直接按索引批量定位：

Dim i As Integer
' 依次定位12张图片
For i = 1 To 12
    With Worksheets("R").Shapes(i)
        ' 示例为依次放在24行到35行，如需固定放在24行可直接写Rows(24).Top
        .Top = Worksheets("R").Rows(23 + i).Top
        .Left = Worksheets("R").Columns(1).Left
    End With
Next

补充调试方法 #

如果不确定当前工作表的所有Shape属性，可以运行以下代码在VBA编辑器的立即窗口打印所有信息，方便核对：

Dim shp As Shape
For Each shp In Worksheets("R").Shapes
    Debug.Print "Shape名称：" & shp.Name & "，可选文字：" & shp.AlternativeText & "，类型：" & shp.Type
Next

注意：如果工作表内还有其他形状（比如批注、按钮、手绘形状等），不要直接用索引定位，避免匹配到错误对象。

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