Снова здравствуйте, дорогие эксперты!
Предыдущую тему я и назвал неверно, и сформулировал расплывчато, за что прошу прощения и конкретизирую вопрос:
Как при использовании метода Shapes.AddPicture сохранить пропорции изображения при его уменьшении?
Пример строки:
Пример скрипта:
Предыдущую тему я и назвал неверно, и сформулировал расплывчато, за что прошу прощения и конкретизирую вопрос:
Как при использовании метода Shapes.AddPicture сохранить пропорции изображения при его уменьшении?
Пример строки:
Код |
---|
Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height) |
Пример скрипта:
Код |
---|
Sub InsertPictures() 'Update 20140513 Dim PicList() As Variant Dim PicFormat As String Dim Rng As Range Dim sShape As Shape On Error Resume Next PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True) xColIndex = Application.ActiveCell.Column If IsArray(PicList) Then xRowIndex = Application.ActiveCell.Row For lLoop = LBound(PicList) To UBound(PicList) Set Rng = Cells(xRowIndex, xColIndex) Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height) xRowIndex = xRowIndex + 1 Next End If End Sub |