Excel-VBA调整单元格大小适应图片

应用场景

调整图片大小以适应单元格、调整单元格大小适应图片

知识要点

1：Shape.LockAspectRatio 属性 如果指定的形状在调整大小时其原始比例保持不变，则此属性为 True，反之为False

2：单元格的height属性与图形对象的height属性单位一致,可直接设置

3：单元格的width宽度和图形对象的width单位不一致，需要转换round(roung(图片宽度/0.75 - iif(图片宽度>9.,5,0),0)/iif(图片宽度>9,8,13),2)进行转换

Sub 让单元格适应图片()

    Dim i As Integer, ShWidth, NewWidth, ShHeight, MaxWidth

    Application.ScreenUpdating = False '关闭屏幕刷新

    With ActiveSheet '引用工作表

        For i = 1 To .Shapes.Count

            .Shapes(i).Left = .Shapes(i).TopLeftCell.Left '统一左边距

            .Shapes(i).Top = .Shapes(i).TopLeftCell.Top '统一上边距

            .Shapes(i).TopLeftCell.RowHeight = .Shapes(i).Height '统一高度

            ShWidth = .Shapes(i).Width  '记录图片的宽度

            '将图片的宽度换算成可以用于列宽的宽度（因为两个单位完全不同)

            '字符，最适合的列宽

            NewWidth = Round(Round(ShWidth / 0.75 - IIf(ShWidth > 9, 5, 0), 0) / IIf(ShWidth > 9, 8, 13), 2)

            If MaxWidth < ShWidth Then  '如果图片在宽度大于变量maxwidth

                '以换算后的宽度为标准设置单元格的宽度

                .Shapes(i).TopLeftCell.ColumnWidth = NewWidth

                MaxWidth = ShWidth '将图片的宽度赋予变量 maxwidth

            End If

        Next i

    End With

    Application.ScreenUpdating = True

End Sub