Microsoft Excel - как вписать изображение в форму?

Question

Я набрал несколько мест изображения в некоторых ячейках и связал их. когда я щелкаю по этим ячейкам, выполняется макрос и заполняет прямоугольную форму изображениями, указанными в этих ячейках. это макрос:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Row = ActiveCell.Row
col = ActiveCell.Column

ActiveSheet.Shapes.Range(Array("Rectangle 38")).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .UserPicture ActiveSheet.Cells(Row, col).Value
    End With

End Sub

работает, но картинка растянута. я хочу, чтобы изображение соответствовало моей форме. в Excel, как вы, наверное, знаете, после заполнения фигуры изображением, под обрезкой есть кнопка подгонки. когда вы щелкаете по нему, он помещается в изображение внутри рамки изображения и сохраняет размер фигуры. я хочу делать то же самое только в VBA.

Answer 1

Используйте свойства формы. PictureWidth , .PictureHeight , .PictureOffsetX = .PictureOffsetY.

Пример кода:

Option Explicit
Public Sub AddPicAndAdjust()

    Dim shp As ShapeRange
    Set shp = ActiveSheet.Shapes.Range(Array("Rectangle 1"))
    With shp.Fill
        .Visible = msoTrue
        .UserPicture "C:\Users\User\Pictures\MyNicePic.png" '<== Add pic
        .TextureTile = msoFalse
        .RotateWithObject = msoTrue
    End With

    'Positioning within fill
    With shp.PictureFormat.Crop
        .PictureWidth = 231
        .PictureHeight = 134
        .PictureOffsetX = 50
        .PictureOffsetY = 28
    End With

    With shp
        .LockAspectRatio = msoFalse
        .IncrementLeft 2
    End With
End Sub