使用嵌套For循环的VBA向Excel插入图片时出现垂直偏移问题

垂直方向图片持续偏移的核心问题是插入图片时自动修改了目标单元格的行高，导致后续循环中ActiveSheet.Cells(arow, acol).Top的计算值被不断放大：

• 你设置的.Placement = 1对应Excel的xlMoveAndSize属性，该属性会让图片与单元格双向绑定：图片随单元格移动，同时单元格会自动调整大小适配图片。
• 若图片高度大于目标单元格的原始行高，插入第一张图片后Excel会自动拉高该行行高。
• 后续循环中，arow = arow + vstep指向的下一个单元格，其Top值是基于被拉高后的行高计算的，自然会越来越靠下，最终出现严重偏移。

以下两种修复方式可根据需求选择：

方式1：修改图片绑定属性（推荐） #

将Placement改为xlMove（值为2），让图片仅随单元格移动，但不触发单元格自动调整大小，从根源避免行高被修改：

Sub insertpic()

Dim img As Picture
Dim fPath As Variant

Dim rows As Integer
Dim cols As Integer

rows = Range("A5").Value '垂直方向插入图片总数
cols = Range("A6").Value '水平方向插入图片总数

startcol = Range("A3").Value '第一张图片起始列
startrow = Range("A4").Value '第一张图片起始行

vstep = Range("A8").Value '垂直方向单元格增量
hstep = Range("A9").Value '水平方向单元格增量

acol = startcol
arow = startrow

For i = 1 To cols
    For j = 1 To rows

        fPath = FolderName & "\" & fName '循环中自动切换到下一张图片路径
        
        Set img = ActiveSheet.Pictures.Insert(fPath)
        
        With img
           .Left = ActiveSheet.Cells(arow, acol).Left
           .Top = ActiveSheet.Cells(arow, acol).Top
           .Placement = 2 ' 修改为xlMove，仅随单元格移动，不调整单元格大小
        End With
        
        arow = arow + vstep
        
    Next j
    
    arow = startrow '下一列从顶部起始行重新开始
    acol = acol + hstep '切换到下一列
    
Next i

End Sub

方式2：提前固定目标单元格行高 #

如果需要保留xlMoveAndSize的双向绑定效果，可以提前将所有目标单元格的行高设置为固定值（匹配图片高度），避免插入图片时行高被修改：

Sub insertpic()

Dim img As Picture
Dim fPath As Variant
Dim targetRowHeight As Single ' 存储图片高度

Dim rows As Integer
Dim cols As Integer

rows = Range("A5").Value '垂直方向插入图片总数
cols = Range("A6").Value '水平方向插入图片总数

startcol = Range("A3").Value '第一张图片起始列
startrow = Range("A4").Value '第一张图片起始行

vstep = Range("A8").Value '垂直方向单元格增量
hstep = Range("A9").Value '水平方向单元格增量

acol = startcol
arow = startrow

' 先插入第一张图片获取高度，批量设置目标行行高
fPath = FolderName & "\" & fName ' 传入第一张图片的路径
Set img = ActiveSheet.Pictures.Insert(fPath)
targetRowHeight = img.Height
img.Delete ' 临时插入获取高度后删除

' 批量设置所有目标行的固定行高
Dim r As Integer
For r = startrow To startrow + (rows - 1) * vstep Step vstep
    ActiveSheet.Rows(r).RowHeight = targetRowHeight
Next r

' 正式循环插入图片
For i = 1 To cols
    For j = 1 To rows

        fPath = FolderName & "\" & fName '循环中自动切换到下一张图片路径
        
        Set img = ActiveSheet.Pictures.Insert(fPath)
        
        With img
           .Left = ActiveSheet.Cells(arow, acol).Left
           .Top = ActiveSheet.Cells(arow, acol).Top
           .Placement = 1 ' 保留xlMoveAndSize双向绑定属性
        End With
        
        arow = arow + vstep
        
    Next j
    
    arow = startrow '下一列从顶部起始行重新开始
    acol = acol + hstep '切换到下一列
    
Next i

End Sub

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