Восстановление размеров картинок в 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);   //непропорционально



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

Leave a Comment

Ваш адрес email не будет опубликован. Обязательные поля помечены *