Страницы: 1
RSS
MS Excel 2007 макрос сжатия картинок при вставке
 
День, добрый, в свое время долго искал решение. возможно кому-то пригодится:
Код
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Target.Address(0, 0)
Case "A2", "A3", "A4", "A5"
    If Application.Dialogs(xlDialogInsertPicture).Show Then
        With Selection
            .ShapeRange.LockAspectRatio = msoFalse
            .Width = Target.Width
            .Height = Target.Height
Dim octl As CommandBarControl
 
With Selection
Application.SendKeys "()~"
Application.CommandBars.ExecuteMso "PicturesCompress"
End With
        End With
    End If
End Select
End Sub

Вставка картинки, подгонка ее по размеру ячейки и сжатие до минимального размера (96 dpi).
Изменено: Ivasy - 17.01.2016 17:41:24
 
А моя программа может и пропорции картинки сохранить, и вставить в любую ячейку,и сжать нормально (без использования SendKeys в коде, - работа которого не гарантируется, тем более в Excel других локализаций)
http://excelvba.ru/programmes/PastePictures
 
 Хм, только один маленький нюанс:  мой исходник бесплатный.  
 
Ivasy,  :D
Страницы: 1
Читают тему
Наверх
Loading...