如何在VBA中调整Word图片高度并保持宽高比？

你的代码只处理了Word中的嵌入式图片（InlineShapes），但文档里如果存在浮动式图片（Shapes），这部分图片不会被调整。另外你添加的.ShapeRange属性对InlineShapes对象不适用，会导致代码报错中断。

下面是修正后的完整代码，同时覆盖两种类型的图片，并且实现你需要的固定高度、保持宽高比，以及将图片定位到B7单元格位置的需求：

Sub ResizeAndPositionAllPics()
    Dim inlinePic As InlineShape
    Dim floatPic As Shape
    Dim targetHeight As Single
    Dim targetTop As Single, targetLeft As Single
    
    ' 设置目标高度（6.9厘米转成Word的磅值）
    targetHeight = CentimetersToPoints(6.9)
    ' 获取B7单元格的位置坐标
    targetTop = ActiveDocument.Range("B7").Top
    targetLeft = ActiveDocument.Range("B7").Left
    
    ' 处理嵌入式图片
    For Each inlinePic In ActiveDocument.InlineShapes
        With inlinePic
            .LockAspectRatio = msoTrue ' 锁定宽高比
            .Height = targetHeight     ' 设置高度，宽度自动按比例调整
            .Top = targetTop           ' 定位到B7的顶部
            .Left = targetLeft         ' 定位到B7的左侧
        End With
    Next inlinePic
    
    ' 处理浮动式图片
    For Each floatPic In ActiveDocument.Shapes
        ' 只处理图片类型的形状，排除文本框、图表等
        If floatPic.Type = msoPicture Then
            With floatPic
                .LockAspectRatio = msoTrue
                .Height = targetHeight
                .Top = targetTop
                .Left = targetLeft
            End With
        End If
    Next floatPic
End Sub

代码关键点说明： #

• 同时遍历InlineShapes和Shapes集合，确保所有图片都被处理
• 对浮动式图片增加了类型判断，避免误调整文本框、图表等非图片形状
• 提前获取B7的坐标值，避免循环中重复读取提升效率
• 明确开启LockAspectRatio = msoTrue，确保调整高度时宽度自动按比例缩放

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