Макрос массового уменьшения размеров всех рисунков

Есть документ Word с картинками (их много) и текстом. Необходимо "ужать" количество страниц. Уменьшить шрифт текста - понятно, но как уменьшить размер всех картинок одновременно, скажем, на 50%?

Сделать это можно с помощью следующего макроса:

Первый вариант:

Sub changeImages()
Dim iShape As InlineShape
For Each iShape In ActiveDocument.InlineShapes
  iShape.Height = iShape.Height * 0.5
  iShape.Width = iShape.Width * 0.5
Next iShape
End sub

Второй вариант для объектов класса Shape или InlineShape:

Sub changeImages2()
Dim pic As Object
For Each pic In ActiveDocument.Content.InlineShapes
  If pic.Type = wdInlineShapePicture Then
    pic.Height = pic.Height / 2
    pic.Width = pic.Width / 2
  End If
Next
For Each pic In ActiveDocument.Content.ShapeRange
  If pic.Type = msoPicture Then
    pic.Height = pic.Height / 2
      If pic.LockAspectRatio = msoFalse Then
        pic.Width = pic.Width / 2
      End If
  End If
Next
End sub

Обратите внимание, что если в документе нет объектов класса Shape (например, автофигур), то макрос вернет ошибку (второй вариант).

• Подписаться на рассылку " Windows и Office: новости и советы "
• Обратиться в «Интерфейс» за дополнительной информацией/по вопросу приобретения продуктов