Excel VBA 自动调整表格图片大小

Sub AutoSizePicture() Dim pic As Picture Dim rng As Range Dim picWidth As Single, picHeight As Single Dim cellWidth As Single, cellHeight As Single Dim ratio As Single

' 选择需要自动调整大小的表格图片
Set pic = Application.Selection

' 获取图片所在的单元格范围
Set rng = pic.TopLeftCell

' 获取单元格的宽度和高度
cellWidth = rng.Width
cellHeight = rng.Height

' 获取图片的原始宽度和高度
picWidth = pic.Width
picHeight = pic.Height

' 计算图片需要缩放的比例
If picWidth > cellWidth Then
    ratio = cellWidth / picWidth
End If

If picHeight > cellHeight Then
    If cellHeight / picHeight < ratio Or ratio = 0 Then
        ratio = cellHeight / picHeight
    End If
End If

' 根据比例缩放图片
If ratio <> 0 Then
    pic.Width = picWidth * ratio
    pic.Height = picHeight * ratio
End If

End Sub