Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Возможно ли сжать изображения макросом
 
#1
06.09.2014 00:01:00
Добрый вечер.
Есть макрос для вставки изображений в Эксель
Код
Sub abc()
 Dim sha As Shape, i As Integer
 i = 2
 Do Until IsEmpty(Cells(i, 1))
 On Error GoTo errors
 Set sha = ActiveSheet.Shapes.AddPicture("D:\1\" & Cells(i, 1) & ".jpg", msoFalse, msoCTrue, Cells(i, 2).Left + 5, Cells(i, 2).Top + 5, 100, 100)
 With sha
 .Placement = xlMoveAndSize
 .Line.Visible = msoTrue
 .Line.ForeColor.ObjectThemeColor = msoThemeColorText1
 End With
errors:
 i = i + 1
 Loop
End Sub

После выполнения которого приходится вручную сжимать изображения:
Сжатие рисунков - качество вывода - электронная почта.
Возможно ли как-нибудь сделать это програмно?
 
 
 
#2
06.09.2014 00:12:18
Наберите в поиске сайта "сжать рисунки". Не так много тем, уже как-то с этим ковырялись.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#3
06.09.2014 15:39:51
Добрый день.
Нашел на форуму тему Макрос сжатия картинок в которой предлагается макрос:
Код
Sub Compress_PIX()
Dim octl As CommandBarControl
With Selection
   Set octl = Application.CommandBars.FindControl(ID:=6382)
   Application.SendKeys "{TAB}"
   Application.SendKeys "{UP}"
   Application.SendKeys "~"
   octl.Execute
End With
End Sub

Но он не сжимает изображения (стоит 2010 Еxcel), об этой же проблеме написано в последнем сообщении BioVR:
Цитата
Господа, кто нибудь может объяснить явление и помочь как именно сделать нужное?
Код приведенный Bobgood не сжимает картинки в 2010 excel, а возможно и в других версиях (еще не проверял). При работе, макрос, вызывается окно отличное от окна "сжатия рисунков" 2007 и 2010 excel. Как вызвать аналогичное 2007 или 2010 excel окно сжатия?
Изменено: Alexander88 - 06.09.2014 15:40:05
 
 
 
#4
06.09.2014 15:49:06
Возникло два вопроса:
1. Что означает в вышеприведенном макросе означает строка:
Код
Application.SendKeys "~"

Строка:
Код
Application.SendKeys "{TAB}"

Насколько я понимаю - нажатие клавиши TAB
2. Возможно ли макросом проверить, есть ли в ячейке изображение?
(если нужно создам новую тему по данному вопросу)
Изменено: Alexander88 - 06.09.2014 15:49:14
 
 
 
#5
06.09.2014 17:17:02
Метод с Application.SendKeys (программным нажатием клавиш на клавиатуре) - крайне ненадежен
«Нормально» макросом эту операцию выполнить нельзя, - это, пожалуй, единственное, что невозможно сделать макросами в Excel

Можно написать отдельный макрос, - но он будет очень сложный:
http://excelvba.ru/code/ResizeImages

Можете воспользоваться готовым решением, которое вставляет уже сжатые изображения на лист Excel:
http://excelvba.ru/programmes/PastePictures

-----------
строка Application.SendKeys "~"
отправляет нажатие клавиши Enter
(поставьте курсор на слово SendKeys, нажмите F1 - в справке по функции все написано)

Цитата
Возможно ли макросом проверить, есть ли в ячейке изображение?
да, для этого надо макросом в цикле перебрать все картинки на листе,
и у каждой картинки проверить свойство TopLeftCell на пересечение с заданной ячейкой (диапазоном ячеек)
Изменено: Игорь - 06.09.2014 17:21:11
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#6
06.09.2014 20:29:31
Спасибо.
Как-нибудь попробую добавить проверку в свой макрос
 
 
 
#7
26.01.2015 15:51:21
Может кому пригодится..
Для вызова окна "сжать рисунки" в 2010 должен быть выделен рисунок
Код
Application.CommandBars.ExecuteMso "PicturesCompress"
 
 
 
Страницы: 1
Читают тему
Наверх