在Excel vba中相对于填充图片的原始大小更改注释大小

试图写一个VBA的Excelmacros，这将允许我插入一个图片作为一个单元格的鼠标hoverpopup。

我通过在单元格中插入注释并将注释的填充设置为指定图片来完成此操作。

我希望这张照片能保持原来的比例

设置好注释后，用图片作为填充背景，我可以手动右键单击单元格，点击编辑注释，右键点击注释，进入“大小”标签，选中“相对于原图大小”checkbox，并设置比例高度和尺寸为100％，达到预期效果，如下图所示：

录制一个macros，看看VBA复制这个是什么都没有被logging。

使用targetComment.Shape.ScaleHeight 1, msoTrue导致错误：

 Run-time error '-2147024891 (80070005)': The RelativeToOriginalSize argument applies only to a picture or an OLE object 

这是生成此错误的VBA代码的屏幕截图：

有谁知道如何通过VBA访问对话框中的内容？

Answer 1

使用注释来显示缩放图像可以完成。 诀窍是自己计算比例因子并将其应用于图像。 我已经使用Windows图像采集自动化层来访问图像文件的尺寸 。

下面的例子访问我的Temp目录中的一个JPG图像，并通过适当的缩放将它添加到单元格的注释中。

 Option Explicit Sub test() '--- delete any existing comment just for testing If Not Range("C5").Comment Is Nothing Then Range("C5").Comment.Delete End If InsertCommentWithImage Range("C5"), "C:\Temp\laptop.jpg", 1# End Sub Sub InsertCommentWithImage(imgCell As Range, _ imgPath As String, _ imgScale As Double) '--- first check if the image file exists in the ' specified path If Dir(imgPath) <> vbNullString Then If imgCell.Comment Is Nothing Then imgCell.AddComment End If '--- establish a Windows Image Acquisition Automation object ' to get the image's dimensions Dim imageObj As Object Set imageObj = CreateObject("WIA.ImageFile") imageObj.LoadFile (imgPath) Dim width As Long Dim height As Long width = imageObj.width height = imageObj.height '--- simple scaling that keeps the image's ' original aspect ratio With imgCell.Comment .Shape.Fill.UserPicture imgPath .Shape.height = height * imgScale .Shape.width = width * imgScale End With End If End Sub