Очень часто необходимо перенести кучу картинок в документ и у каждой изменить размер, так чтобы она вписывалась в размер страницы. Как это сделать автоматически? с помощью vba макроса.

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

Dim iShape As InlineShape
For Each iShape In ActiveDocument.InlineShapes
newW = 100
WH = iShape.Width / iShape.Height
iShape.Width = MillimetersToPoints(newW)
iShape.Height = MillimetersToPoints(newW / WH)

Next iShape
End Sub

Это пример макроса для установки ширины(Width) картинки в 100 мм (10 см)(переменная newW). Высота(Height) рассчитывается пропорционально.

Для того чтобы установить этот макрос себе в ворд необходимо нажать Alt + F11.  В дереве проекта перейти в Normal — Module — NewMacros. Вставить текст макроса и сохранить.  Для запуска необходимо в word нажать Alt + F8, выбрать «changeImagesWidth» и нажать «выполнить»

По аналогии меняется и высота рисунка.

Для того чтобы каждый раз при запуске появлялось окно с вопросом какую высоту(ширину) установить необходимо

1
newW = 100

заменить на

1
newW = InputBox("Укажите ширину", "Изменение всех рисунков", "100")

 

Для того чтобы обрабатывать только изображения только в выделенном диапазоне необходимо

1
For Each iShape In ActiveDocument.InlineShapes

заменить на

1
For Each iShape In Selection.InlineShapes