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

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

1 个答案: