Страница 1 из 1

Cжать рисунки средствами VBA

Добавлено: 17 янв 2009, 15:29
EducatedFool
Задача: сжать рисунки о офисном файле (в частности, в книге Excel) средствами VBA
(на панели Настройка изображения есть кнопочка Сжатие рисунков)

Проблема: макрорекордер ничего не пишет (ни в Office 2003, ни в 2007-м)
У объектов типа IPicture, IPictureDisp, Shape нет соотвествующих методов и свойств. (по крайней мере, найти мне не удалось)
Поиск ничего не дал - на других форумах видел пару аналогичных вопросов - но без ответов...

Скорее всего, функция оптимизации изображения находится в общей для всех офисных программ библиотеке
(либо в exe-файле программы Microsoft Office Picture Manager)
Знать, хотя бы, в какой библиотеке искать эту функцию...

Должно же быть возможно выполнить это действие средствами VBA.
SendKeys использовать не хочется...

Re: Cжать рисунки средствами VBA

Добавлено: 17 янв 2009, 18:13
Teslenko_EA
Здравствуйте EducatedFool.
Не достаточно ли простого изменения размера отображаемого рисунка, С такой задачей VBA справляется легко:

Код: Выделить всё

Sub resizePic()
    With ActiveSheet.Shapes("Picture 2")
        .LockAspectRatio = True 'False
        .Height = 400
        '.Width = 200
    End With
End Sub
Евгений.

Re: Cжать рисунки средствами VBA

Добавлено: 17 янв 2009, 18:48
EducatedFool
Здравствуйте, Евгений.

К сожалению, изменение размеров не поможет - рисунки уже имеют нужный размер.
Вот только глубина цвета у них 24 bit, да и разрешение высокое.

После вставки рисунков файл весит более 5 мегабайтов, а после сжатия размер файла значительно уменьшается (до 64 Кбайтов)

Видимо, эта встроенная функция урезает глубину цвета и разрешение изображения.
При этом визуально ухудшение качества изображения не наблюдается.

Вот и хотелось бы добиться такого эффекта не нажатием кнопок, а средствами VBA...

Игорь.