调整图像或单元格的大小以根据需要制作图片

时间:2019-05-10 14:49:26

标签: excel vba

我已经用VBA编写了代码,所有代码都可以使用,但是我需要调整图片大小以使其更大一点。

在下面我需要做些什么来调整它的大小?

Sub InsertPictures()
'Update 20140513
Dim Picture() As Variant
Dim PicFormat As String
Dim Picturee As Object
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 + 4

    Next
End If
End Sub

1 个答案:

答案 0 :(得分:0)

u可以定义您想要的任何大小。只需使用宽度和高度即可。

这将使图像大小增加100像素

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)

    sShape.Width = sShape.Width + 100
    sShape.Height = sShape.Height + 100

    xRowIndex = xRowIndex + 4

Next

或者简单地

    Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width+100, Rng.Height+100)