微软 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

微软 excel - 如何使图像适合形状？

microsoft excel - how to fit image inside shape?

excel

vba

ms-office