День, добрый, в свое время долго искал решение. возможно кому-то пригодится:
| Код |
|---|
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).
