Microsoft Word – это один из моих основных инструментов для создания записей блога, в которых традиционно много снимков экрана. Сегодня я покажу вам интересный макрос, который экономит массу времени при работе с такими документами.

С приходом Windows 8 и ее полноэкранных приложений в моих документах выросло число больших картинок, что затрудняло написние текста и навигацию. Word не запоминает масштаб последней вставленной картинки, подгоняя ее под размер страницы. Но даже если уменьшать каждое изображение вручную, то для публикации в блоге мне в итоге все равно нужны картинки в масштабе 100%.

Я решил упростить себе жизнь!

Как выглядит макрос

Недолгие поиски привели меня к макросу, который одним сочетанием клавиш позволяет задать одинаковый масштаб всем картинкам документа Word.

В основе лежит код VBA.

 Sub AllPictSize()          Dim PercentSize As Integer          Dim oIshp As InlineShape          Dim oshp As Shape                PercentSize = InputBox("Enter percent of full size", "Resize Picture", 100)                For Each oIshp In ActiveDocument.InlineShapes              With oIshp                  .ScaleHeight = PercentSize                  .ScaleWidth = PercentSize              End With          Next oIshp                For Each oshp In ActiveDocument.Shapes              With oshp                  .ScaleHeight Factor:=(PercentSize / 100), _                    RelativeToOriginalSize:=msoCTrue                  .ScaleWidth Factor:=(PercentSize / 100), _                    RelativeToOriginalSize:=msoCTrue              End With          Next oshp      End Sub

Я выделил строку, которая определяет стандартный масштаб, отображаемый в диалоге.

Как добавить макрос

Проще простого!

1. В Word нажмите сочетание клавиш Alt + F11, вставьте код в редактор, нажмите Ctrl + S, затем Alt + F4.
2. Нажмите Alt + F8 и запустите макрос AllPictSize. Все!

Для полного счастья в настройках ленты я повесил на макрос сочетание клавиш Alt + P.

Обратите внимание, как сокращаются инструкции, когда в них включаются сочетания клавиш. Даже картинки не нужны 🙂 Кстати, я посмотрел, что у меня очень много записей про сочетания клавиш, и сделал им отдельный тег.

А вы используете макросы в Office дома или на работе? Расскажите в комментариях, для чего они у вас служат!

	Здесь можно получить ответы на вопросы по Microsoft Excel	58375	477694	3 Ноя 2018 18:24:01
		44519	357828	29 Янв 2017 17:28:40
	Лучшие избранные темы с основного форума	14	80	28 Июн 2018 15:25:11
	Если вы — счастливый обладатель Mac 😉	219	1065	25 Окт 2018 09:26:29
	Раздел для размещения платных вопросов, проектов и задач и поиска исполнителей для них.	2131	13610	3 Ноя 2018 18:19:40
	Если Вы скачали или приобрели надстройку PLEX для Microsoft Excel и у Вас есть вопросы или пожелания — Вам сюда.	316	1613	2 Ноя 2018 17:35:31
		816	11888	3 Ноя 2018 11:34:46
	Обсуждение функционала, правил и т.д.	270	3481	30 Окт 2018 15:01:36

Сейчас на форуме (гостей: 566, пользователей: 14, из них скрытых: 3) , , , , , , , , , ,

Сегодня отмечают день рождения (52), (62)

Всего зарегистрированных пользователей: 83706

Приняло участие в обсуждении: 32109

Всего тем: 106658

Что делать, если искажается размер картинок.

При сохранении табличного документа в формате .xlsx могут искажаться размеры картинок (логотипы, диаграммы и т.п.).
Проблема осложняется тем, что в Excel размеры задаются не в метрических единицах, а в пунктах.
Чтобы восстановить размеры в мм, обработайте получившийся лист при помощи такого кода (увы, размер придется вновь задавать в коде или считывать из коллекции рисунков документа):

Процедура ПоправитьКартинки(Эксель)    	msoFalse=0;  	msoTrue=1;  	msoPicture=13;  	  	  	ТаблицаРазмеров=Новый ТаблицаЗначений;  	ТаблицаРазмеров.Колонки.Добавить("Height"); // в мм  	ТаблицаРазмеров.Колонки.Добавить("Width");    	  	  		нс=ТаблицаРазмеров.Добавить(); // логотип  		  		нс.Height=14;  		нс.Width=55;  		  		нс=ТаблицаРазмеров.Добавить(); // круговая диаграмма  		нс.Height=45;  		нс.Width=101;  		  			  	ы=0;  	Для Каждого Shape Из Эксель.ActiveSheet.Shapes Цикл    		Если Shape.Type=msoPicture  Тогда  			УстановитьРазмерРисунка(Эксель,Shape,ТаблицаРазмеров.Height,ТаблицаРазмеров.Width);		  			ы=ы+1;  		КонецЕсли;	  			  	КонецЦикла;	  	  	//Эксель.Visible = 1;	  	//Эксель.Quit();  	//Эксель = Неопределено;  	  КонецПроцедуры	    // Устанавливает новый размер рисунка в мм  // App_E - COM-объект Excel  Процедура УстановитьРазмерРисунка(App_E,Shape,Height,Width)  	msoFalse=0;  	msoTrue=1;  	mmTOpoints = App_E.CentimetersToPoints(0.1);  	  	Shape.LockAspectRatio = msoFalse;  	Heightmm = Shape.Height / mmTOpoints;  	Widthmm = Shape.Width / mmTOpoints;  	  	ScaleHeightK=Height/Heightmm ;  	ScaleWidthK=Width/Widthmm;  	  	Shape.ScaleHeight(ScaleHeightK,msoFalse,0); //непропорционально  	Shape.ScaleWidth(ScaleWidthK,msoFalse,0);   //непропорционально  	  	    КонецПроцедуры	

Ссылка на публикацию

HTML