如何改进VBA代码实现点击按钮在Excel工作表不同位置插入多图

方案1：自定义每张图片的插入位置 #

这个方案允许你一次性选择多张图片，然后依次指定每张图片的插入单元格位置，灵活性更高。

Sub InsertMultiplePicturesAtCustomPositions()
    Dim fNamesAndPaths As Variant
    Dim img As Picture
    Dim targetCell As Range
    Dim i As Integer
    
    ' 开启多选模式，过滤常见图片格式
    fNamesAndPaths = Application.GetOpenFilename( _
        FileFilter:="图片文件 (*.jpg;*.png;*.bmp;*.gif), *.jpg;*.png;*.bmp;*.gif", _
        Title:="选择要插入的图片（可按住Ctrl多选）", _
        MultiSelect:=True)
    
    ' 用户取消选择则退出
    If TypeName(fNamesAndPaths) = "Boolean" Then Exit Sub
    
    ' 遍历所有选中的图片文件
    For i = LBound(fNamesAndPaths) To UBound(fNamesAndPaths)
        ' 弹出对话框让用户点击目标单元格
        On Error Resume Next
        Set targetCell = Application.InputBox( _
            Prompt:="点击第" & i & "张图片的插入位置单元格", _
            Title:="选择插入位置", _
            Type:=8)
        On Error GoTo 0
        
        ' 用户取消选择则跳过当前图片
        If targetCell Is Nothing Then
            MsgBox "已跳过第" & i & "张图片"
            GoTo NextImage
        End If
        
        ' 插入图片并对齐到目标单元格
        Set img = ActiveSheet.Pictures.Insert(fNamesAndPaths(i))
        With img
            .Top = targetCell.Top
            .Left = targetCell.Left
            ' 可选：取消注释让图片适配单元格大小（会拉伸）
            '.ShapeRange.LockAspectRatio = msoFalse
            '.Width = targetCell.Width
            '.Height = targetCell.Height
        End With
        
NextImage:
    Next i
    
    MsgBox "图片处理完成！"
End Sub

关键改动说明：

• 给GetOpenFilename加上MultiSelect:=True，支持多选图片
• 用循环遍历所有选中的文件，逐个处理
• 通过Application.InputBox(Type:=8)获取用户指定的插入单元格
• 设置图片的Top和Left属性，让图片对齐到目标单元格的左上角

方案2：按顺序自动排列插入图片 #

如果需要批量插入图片并自动按行/列排列，这个方案更高效，只需指定起始位置，图片会自动往下/往右排列。

Sub InsertMultiplePicturesInSequence()
    Dim fNamesAndPaths As Variant
    Dim img As Picture
    Dim startCell As Range
    Dim i As Integer
    Dim rowOffset As Integer
    
    ' 开启多选模式
    fNamesAndPaths = Application.GetOpenFilename( _
        FileFilter:="图片文件 (*.jpg;*.png;*.bmp;*.gif), *.jpg;*.png;*.bmp;*.gif", _
        Title:="选择要插入的图片（可多选）", _
        MultiSelect:=True)
    
    If TypeName(fNamesAndPaths) = "Boolean" Then Exit Sub
    
    ' 让用户选择图片插入的起始单元格
    On Error Resume Next
    Set startCell = Application.InputBox( _
        Prompt:="选择插入图片的起始单元格", _
        Title:="设置起始位置", _
        Type:=8)
    On Error GoTo 0
    
    If startCell Is Nothing Then
        MsgBox "未选择起始位置，程序退出"
        Exit Sub
    End If
    
    rowOffset = 0 ' 行偏移量，每张图片向下偏移一行
    
    For i = LBound(fNamesAndPaths) To UBound(fNamesAndPaths)
        Set img = ActiveSheet.Pictures.Insert(fNamesAndPaths(i))
        With img
            ' 对齐到当前偏移后的单元格
            .Top = startCell.Offset(rowOffset, 0).Top
            .Left = startCell.Left
            ' 可选：固定图片宽度，高度按比例自适应
            '.ShapeRange.LockAspectRatio = msoTrue
            '.Width = 120 ' 可根据需求调整宽度值
        End With
        
        rowOffset = rowOffset + 1 ' 下一张图片下移一行
        ' 如果要按列排列，替换成 columnOffset = columnOffset +1，用 Offset(0, columnOffset)
    Next i
    
    MsgBox "图片已按顺序插入完成！"
End Sub

关键改动说明：

• 同样支持多选图片，通过起始单元格+偏移量实现自动排列
• 可以轻松切换按行/列排列，只需修改偏移量的方向
• 可选固定图片大小，避免图片尺寸差异过大影响排版

内容的提问来源于stack exchange，提问作者Amira Mohamed Abdelsalam