gifts2017

Восстановление размеров картинок в Excel

Опубликовал Сисой Сисой (Сисой) в раздел Программирование - Практика программирования

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

При сохранении табличного документа в формате .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);   //непропорционально
	
	

КонецПроцедуры	

См. также

Подписаться Добавить вознаграждение
В этой теме еще нет сообщений.