по мотивам предыдущей записи… Часто бывает нужно вписать кучу картинок в документ word. но картинки бываю портретного и ландшафтного форматов. Заставляем word автоматически поворачивать изображения.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Rotation90()

Dim iShape As InlineShape

For i = 1 To ActiveDocument.InlineShapes.Count Step 1

Set iShape = ActiveDocument.InlineShapes(i)

If (iShape.Height > iShape.Width) Then
Set myShape = iShape.ConvertToShape
myShape.Rotation = 90
myShape.ConvertToInlineShape
End If

Next i

End Sub

Для vba изображения в документе делятся на два типа InlineShape и Shape. Когда мы просто перетаскиваем изображения в документ, их тип устанавливается InlineShape и так просто её не перевернуть. По этому макрос проверяет нужно ли переворачивать изображение (высота больше ширины) и затем преобразует изображение в тип Shape, которые с лёгкостью можно повернуть. А затем обратно, чтобы изображения в документе не «наезжали» друг на друга.

А потом уже можно вписывать по ширине в лист

1
2
3
4
5
6
7
8
9
10
11
Sub changeImagesWidthList()

For Each iShape In ActiveDocument.InlineShapes

WH = iShape.Width / iShape.Height
iShape.Width = MillimetersToPoints(180)
iShape.Height = MillimetersToPoints(180 / WH)

Next iShape

End Sub