如何用vba获取图片的原始尺寸？

在excel、word、ppt等软件中插入图片后，都可以从图片的大小和位置属性中查看到图片的原图尺寸，如下图所示：

其中数字1处显示的是图片的原始尺寸，数字2处显示的是图片的现在尺寸，数字3处显示的是图片的缩放比例。

在vba中，图片对象Shape的Height属性和Width属性表示的是数字2处的图片的现在的尺寸。

如果要获取图片的原始尺寸，可以利用ScaleWidth方法和ScaleHeight方法。

这两个方法分别可以将图片的宽度和高度等比例缩放，还可以选择是基于现在的尺寸还是图片的原始尺寸缩放。

代码如下：

Sub QQ1722187970()
    Dim oSP As Shape
    Dim oWK As Worksheet
    Set oWK = Excel.ActiveSheet
    Set oSP = oWK.Shapes(1)
    With oSP
        '之前的高和宽
        iH = .Height
        iW = .Width
        .ScaleHeight 1, msoCTrue
        .ScaleWidth 1, msoCTrue
        '原来的高和宽
        iHO = .Height
        iWO = .Width
        '输出原始的图片的高和宽，以厘米为单位
        Debug.Print Point2Centimeters(iHO), Point2Centimeters(iWO)
        '重置为图片一开始的尺寸
        .Height = iH
        .Width = iW
    End With
End Sub
Function Point2Inch(ByVal dPoint As Double)
    'Point转Inch
    Point2Inch = dPoint * 1 / 72
End Function
Function Inch2Point(ByVal dInch As Double)
    'Inch转Point
    Inch2Point = dInch * 72
End Function
Function Point2Centimeters(ByVal dPoint As Double)
    'Point转Centimeter
    Point2Centimeters = dPoint * 1 / 72 * 2.54
End Function
Function Centimeters2Point(ByVal dCentimeter As Double)
    'Centimeter转Point
    Centimeters2Point = dCentimeter * 72 * 1 / 2.54
End Function