如何使用 VBA 在 Word 中将多个图像裁剪成相同大小并使其适合容器形状

Question

我想在 Word 文档中将多个图像调整为相同大小。对于单个图像，我可以设置其框架的高度和宽度，或者容器形状（如果您愿意），然后将图像填充到该框架。如何将这些程序翻译成VBA?

我已经写了一个宏来调整多张图片的大小，但它不能很好地填充图片到它的框架。这是代码：

Option Explicit

Sub crop_image()
' resize all selected inline images to specific dimensions

Dim i As Byte

'set desired width and height of an image.
Dim w As Single 'width
Dim h As Single 'height
Dim r As Single 'height-width ratio
w = 8
h = 5.5
r = h / w

With ActiveWindow.Selection
For i = 1 To .InlineShapes.Count
    With .InlineShapes(i)
        'if the image is tall & thin
        If .Height / .Width > r Then
            .Width = CentimetersToPoints(w)
            .PictureFormat.Crop.ShapeHeight = CentimetersToPoints(h)
        'if the image is short & fat
        ElseIf .Height / .Width < r Then
            .Height = CentimetersToPoints(h)
            .PictureFormat.Crop.ShapeWidth = CentimetersToPoints(w)
        End If
    End With
Next i
End With

End Sub

Answer 1

我自己想办法。

Sub crop_image()
' resize all selected inline images to specific dimensions

Dim i As Byte

'set desired width and height of an image.
Dim h As Single 'desired height
Dim w As Single 'desired width
Dim r As Single 'desired height-width ratio

h = CentimetersToPoints(6)
w = CentimetersToPoints(8)
r = h / w

Dim h0 As Single 'original height
Dim w0 As Single 'original width
Dim r0 As Single 'original height-width ratio

With activewindow.Selection
For i = 1 To .InlineShapes.Count
With .InlineShapes(i)
    'reset image
    With .PictureFormat.Crop
        h0 = .PictureHeight
        w0 = .PictureWidth
        r0 = h0 / w0
    End With

    If r0 > r Then      'if the image is tall & thin
    .Width = w
    With .PictureFormat.Crop
        .ShapeHeight = h
        .PictureWidth = w
        .PictureHeight = w * r0
    End With
    center .PictureFormat.Crop

    ElseIf r0 < r Then  'if the image is short & fat
    .Height = h
    With .PictureFormat.Crop
        .ShapeWidth = w
        .PictureHeight = h
        .PictureWidth = h / r0
    End With
    center .PictureFormat.Crop
    End If
End With
Next i
End With
End Sub

Function center(c As Crop) As Byte
c.PictureOffsetX = 0
c.PictureOffsetY = 0
End Function

不过，我期待更简洁的解决方案。

如何使用 VBA 在 Word 中将多个图像裁剪成相同大小并使其适合容器形状

How to crop multiple images to same size while fitting them to their container shapes in Word using VBA

vba

ms-word

crop

resize-image