Как обрезать несколько изображений до одинакового размера, подгоняя их под формы контейнера в Word, используя VBA - PullRequest
Новая
       30

Как обрезать несколько изображений до одинакового размера, подгоняя их под формы контейнера в Word, используя VBA

0 голосов
/ 30 марта 2019

Я хочу изменить размер нескольких изображений до одного размера в документе 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

1 Ответ

0 голосов
/ 30 марта 2019

Я сам разбираюсь.

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

Я с нетерпением жду более краткого решения.

...