vba 确定VBA中图片对象的实际大小和显示大小
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/28212898/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Determine actual and displayed size of picture object in VBA
提问by python dude
In VBA, I'm trying to determine both the actual and the displayed size of a picture object on a worksheet. The displayed size can be different from the actual size due to scaling factors. So far, I've found the methods ScaleWidthand ScaleHeight, but I don't want to actually modify the picture object. Any ideas?
在 VBA 中，我试图确定工作表上图片对象的实际大小和显示大小。由于缩放因子，显示的大小可能与实际大小不同。到目前为止，我已经找到了方法ScaleWidth和ScaleHeight，但我不想实际修改图片对象。有任何想法吗？
采纳答案by Marek Stejskal
Unfortunatelly, it seems that the original measurements are not a public property of a picture. If you do not want to modify the original picture, you can create a duplicate of the said picture just for the scaling purpose.
不幸的是，原始测量值似乎不是图片的公共财产。如果您不想修改原始图片，您可以创建所述图片的副本，仅用于缩放目的。
This function accepts a shape (a picture in our case) and returns an array of Single type (width and height)
这个函数接受一个形状（在我们的例子中是一张图片）并返回一个单一类型（宽度和高度）的数组
Private Function GetOriginalMeasurements(ByRef myShape As Excel.Shape)
Dim shpCopy As Excel.Shape
Dim measurements(1) As Single
Set shpCopy = myShape.Duplicate
' Reset original measurements
shpCopy.ScaleHeight 1, msoTrue
measurements(0) = shpCopy.width
measurements(1) = shpCopy.height
shpCopy.Delete
GetOriginalMeasurements = measurements
End Function
The Main() procedure is just a basic example of how to use it
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
On my computer the duplicating and deleting of the shape is instant, but if you see some flickering, you may wish to turn off screen updating in that function.
在我的电脑上，形状的复制和删除是即时的，但如果您看到一些闪烁，您可能希望关闭该功能中的屏幕更新。
