1

Тема: Изменение всех рисунков в файле в определенное количество раз

Данный макрос может использоваться для изменения (увеличения или уменьшения) всех рисунков в файле в некоторое количество раз (на единый коэффициент):

Sub ScalePic1()
    Dim inshp As InlineShape
    For i = 1 To ActiveDocument.InlineShapes.Count
        'Перебор всех картинок в файле
        Set inshp = ActiveDocument.InlineShapes(i)
        'Установка пропорциональности изменения картинки
        inshp.LockAspectRatio = msoTrue
        'Собственно изменение размера картинки
        '(в данном примере - увеличение картинки в 2 раза)
        inshp.Height = inshp.Height * 2
    Next
End Sub

Примечание: В случае, если обрабатываемый файл - достаточно большой и в нем содержится много картинок, то данный макрос может работать достаточно долго. Необходимо подождать, пока он закончит работу над файлом.

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.