在VBA中确定图片对象的实际大小和显示大小

在VBA中，我试图确定工作表上图片对象的实际大小和显示大小。由于比例因子的原因，显示的大小可能与实际大小不同。到目前为止，我已经找到了方法

ScaleWidth

和

scalewhight

，但我不想实际修改picture对象。有什么想法吗？

不幸的是，原始测量值似乎不是图片的公共属性。如果您不想修改原始图片，您可以仅为缩放目的创建所述图片的副本

此函数接受一个形状（在本例中为图片），并返回一个单一类型的数组（宽度和高度）

Main（）过程只是如何使用它的一个基本示例

Sub Main()
    Dim myShape As Excel.Shape
    Dim measurements() As Single
    Dim width As Single
    Dim height As Single

    Set myShape = ActiveWorkbook.ActiveSheet.Shapes(1)
    measurements = GetOriginalMeasurements(myShape)

    width = measurements(0)
    height = measurements(1)

    Debug.Print width
    Debug.Print height
End Sub

---

在我的电脑上，形状的复制和删除是即时的，但是如果您看到一些闪烁，您可能希望在该功能中关闭屏幕更新。

注意：有三种尺寸需要考虑。1） 屏幕上的大小2）插入程序的大小3）磁盘上的分辨率。如果图像的dpi（例如）为150，PowerPoint会将图像缩放到其屏幕dpi（例如）72，以便您看到的图像约为原始大小的一半。如果提取图像（或选择“另存为…”），然后检查文件的尺寸，您会发现它比预期的大得多。您还可以通过将PowerPoint文件重命名为.zip，然后打开zip文件来检查尺寸。有一个包含所有原始图像的ppt/媒体文件夹。这也可以解释为什么有时磁盘上PowerPoint文件的大小比预期的大。

Sub Main()
    Dim myShape As Excel.Shape
    Dim measurements() As Single
    Dim width As Single
    Dim height As Single

    Set myShape = ActiveWorkbook.ActiveSheet.Shapes(1)
    measurements = GetOriginalMeasurements(myShape)

    width = measurements(0)
    height = measurements(1)

    Debug.Print width
    Debug.Print height
End Sub