excel对某列的表格图片自动调整大小vba代码

Sub AutoFitPictures() Dim pic As Picture Dim c As Range, r As Range Dim w As Double, h As Double Dim maxH As Double, maxW As Double

'设置最大宽高
maxW = 100 '设置最大宽度为100
maxH = 100 '设置最大高度为100

For Each pic In ActiveSheet.Pictures
    Set c = pic.TopLeftCell
    Set r = c.Offset(1, 0)
    Do Until r.Row > c.Row + 10 Or r.Value <> ""
        Set r = r.Offset(1, 0)
    Loop
    If r.Row > c.Row + 10 Then
        w = c.Offset(0, 1).Left - c.Left
        h = r.Top - c.Top
        If w > maxW Or h > maxH Then
            If w > maxW Then
                pic.Height = h * maxW / w
                pic.Width = maxW
            Else
                pic.Width = w * maxH / h
                pic.Height = maxH
            End If
        End If
    End If
Next pic

End Sub

注：此代码用于自动调整表格中图片的大小，使其不超过设置的最大宽度和高度。可以根据需要修改最大宽度和高度的值。另外，代码会自动寻找每个图片所在单元格下面的第一个非空单元格，然后根据该单元格所在行和图片所在行的距离计算图片的高度。如果需要调整计算方式，可以修改代码中的相关部分。