excel - 在保持纵横比的同时调整图片大小

Question

我想调整图像大小，保持纵横比。

Public Sub ResizeCab2()

Dim targetSheet As Worksheet
Dim targetRange As Range
Dim targetShpe As Shape

' Define the sheet that has the pictures
Set targetSheet = ThisWorkbook.ActiveSheet
' Define the range the images is going to fit
Set targetRange = targetSheet.Range("B3:K24")

' Loop through each Shape in Sheet
For Each targetShape In targetSheet.Shapes

    ' Check "picture" word in name
    If targetShape.Name Like "*Picture*" Then
        ' Call the resize function
        SizeToRange targetShape, targetRange
    End If

Next targetShape

Call CableOddEven

End Sub

TargetSheet.Range表示图像必须在上述指定范围内。这意味着，当我的图像大小不适合 Excel 中的范围时，我的图像被扭曲了。

如果我取消范围，并将其限制在一个单元格中，如下面的代码所示：

Public Sub ResizeCab2()

    Dim targetSheet As Worksheet
    Dim targetRange As Range
    Dim targetShpe As Shape
    
    ' Define the sheet that has the pictures
    Set targetSheet = ThisWorkbook.ActiveSheet
    ' Define the range the images is going to fit
    Set targetRange = targetSheet.Range("B3")
    
    ' Loop through each Shape in Sheet
    For Each targetShape In targetSheet.Shapes

        ' Check "picture" word in name
        If targetShape.Name Like "*Picture*" Then
            ' Call the resize function
            SizeToRange targetShape, targetRange
        End If

    Next targetShape
    
End Sub

然后我只得到这个单元格中的图像

这是函数，它带有这两个代码：

Private Sub SizeToRange(ByVal targetShape As Shape, ByVal Target As Range)

    ' Adjust picture properties
    With targetShape
        ' Check if next line is required...
        .LockAspectRatio = msoTrue
        .Left = Target.Left + 10
        .Top = Target.Top - 4
        .Width = Target.Width - 20
        .Height = Target.Height
        .ZOrder msoSendToBack
    End With

    ' Adjust picture border properties
    With targetShape.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
        .Visible = msoTrue
        .Weight = 1
    End With

End Sub

我还在这个函数中做了一些小的改动，替换了：

        .Left = Target.Left + 10
        .Top = Target.Top - 4

和

         .Top = Range("B3").Top
        .Left = Range("B3").Left

但没有效果，即使使用.LockAspectRatio = msoTrue.

我不需要扭曲这些图像。我希望它们粘在一个单元格表示的一个（即左上角）角上。

标签： excelvbaimage