Статьи из блога
Статьи из блога
Макрос массового уменьшения размеров всех рисунков
Рубрика: Вопрос-Ответ, Макросы, Стили и форматирование
Метки: макросы | рисунки | форматирование
Суббота, 10 ноября 2007 г.
Просмотров: 7568
Подписаться на комментарии по RSS
Версия для печати
Метки: макросы | рисунки | форматирование
Суббота, 10 ноября 2007 г.
Просмотров: 7568
Подписаться на комментарии по RSS
Версия для печати
Иван задал вопрос:
Есть документ 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
On Error Resume Next
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
Поиск
Рубрики
Подписка
Читают
Обсуждают
страницы
сайты
статистика
Комментариев: 21
Очень полезный макрос, спасибо за то, что не забываете о нас
ScannerDoctor
Пакет форматирования в MS Word отсканированных книг.
Разработано на платформе MS Office Word 2003 SP2.
Опробовано на документах полученных ABBYY FineReader 7-8.
Автор: Александр, alex-mail@tut.by, Брест, 2005-2007.
Скачать можно по адресу: http://alex-mail.at.tut.by/.
Надо найти поподробнее
Подскажите, будьте добры, что нужно изменить в этом макросе, чтобы он уменьшал размер рисунков не в процентах от исходного значения, а точно - в см?
Т.е. нужно, допустим, чтобы все рисунки были по высоте 12 см. А ширина чтобы изменилась автоматически пропорционально.
Могу предложить вариант для изменения выделенного графического объекта (не всех, а конкретного выделенного объекта).
Может кто предложить макрос для прохода по всем (!) графическим объектам?
Sub changeSizeImage() 'Изменение размера для выделенного графического объекта Dim hSp As Single Dim h As Single h = 12 On Error Resume Next With Selection Select Case .Type Case Word.WdSelectionType.wdSelectionInlineShape hSp = PointsToCentimeters(.InlineShapes(1).Height) If hSp > h Then .InlineShapes(1).Height = CentimetersToPoints(h) Case Word.WdSelectionType.wdSelectionShape hSp = PointsToCentimeters(.ShapeRange.Height) If hSp > h Then .ShapeRange.Height = CentimetersToPoints(h) Case Else MsgBox "Не графический объект" End Select End With End SubДля всех картинок (InlineShape):
Для всех рисунков (Shape), типа автофигур:
Антон, спасибо.
Только не могу понять одну вещь. Макрос правильно работает на новых вставляемых в документ рисунках, но не работает на уже вставленых и изменённых/отформатированных ранее. Вообще ничего не происходит. Сверил все настройки рисунков, вроде бы всё совпадает (на новых и старых).
А также первый макрос (changeSizeImage) нельзя использовать если одновременно выделить два и более рисунка. Часто нужно изменить не все рисунки в документе, а выделить несколько штук и изменить их размер.
Обратил внимание также, что это и вручную сделать нельзя - если выделить два и более рисунка, то в поля Высота/Ширина ничего нельзя ввести. Т.е. получается нельзя ничего сделать?
Вы просили:
Я предложил три варианта: первый работает только с выделенным одним объектом. Второй и третий вариант макроса работают с графическими объектами (всеми, имеющимися в документе).
Разумеется, для отдельных случаев использования нужно думать и менять.
Так, а размеры старых каковы?
Как вам это удается? Или они у вас идут друг за другом, то есть не разделены текстом? Но даже если и так, это два разных объекта.
"Так, а размеры старых каковы?"
Размеры любые могут быть. Отличные от 12 см.
"Как вам это удается? Или они у вас идут друг за другом, то есть не разделены текстом? Но даже если и так, это два разных объекта."
Да, действительно, выделить одновременно можно только 2 идущих подряд рисунка. Тогда вопрос отпадает.
P.S. как вставлять цитату здесь?
Используйте теги blockquote.
Я вот подумал, а если указывать номера нужных рисунков, чтобы именно их макрос и обрабатывал? У вас же наверное идут подрисуночные подписи? Там определены номера. Хотя можно и автоматически подсчитывать...
Впрочем, мне кажется, что все-таки удобнее последовательно выбирать нужный рисунок и применять к каждому макрос из комментария №5.
Да, подписи с номерами есть, но в разных разделах своя нумерация, и плюс она может идти даже не подряд. Так что смотря какие номера указывать. Ну в любом случае с указыванием номера будет не очень удобно. Так что пожалуй соглашусь, что при невозможности одноврменного выделения нескольких рисунков удобнее всего выделять по одному и применять к каждому макрос.
Спасибо.
Поправка: макросы Word работают только с одним, последовательным, последним из выделенных блоков. Т.е. невозможно выделить несколько блоков с рисунками, а в одном выделено блоке рисунков может быть сколько угодно.
Для масштабирования лучше использовать функции Shape.ScaleHeight и Shape.ScaleWidth.
Вот вариант макроса, позволяющий измерять масштаб всех рисунков в выделенной области:
Sub SetNewSizeImages() ' ' SetNewSizeImages Макрос ' Макрос создан 15.05.2010 Excellence ' ' Изменяет размер всех выделенных рисунков Dim iShape As InlineShape Dim iScale As Single iScale = InputBox("Укажите масштаб", "Изменение всех рисунков", "50") For Each iShape In Selection.InlineShapes iShape.ScaleHeight = iScale iShape.ScaleWidth = iScale Next iShape End SubА реально ли заставить макрос обрабатывать "горизонтальные" изображение по одному параметру, а "вертикальные" по другому?
Роман, это реально. Достаточно проанализировать соотношение сторон (Width и Height). Если Вас интересует что-то более конкретное, то приходите на форум, там и обсудим.
Вопрос: как сделать все картинки не более 8-9см? по горизонтали?
Благодарю вас, дамы и господа, вы сэкономили мне год жизни!