Тема: Изменение всех рисунков в файле в определенное количество раз
Данный макрос может использоваться для изменения (увеличения или уменьшения) всех рисунков в файле в некоторое количество раз (на единый коэффициент):
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
Примечание: В случае, если обрабатываемый файл - достаточно большой и в нем содержится много картинок, то данный макрос может работать достаточно долго. Необходимо подождать, пока он закончит работу над файлом.
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.