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

Question

尝试编写一个VBA excel宏，它允许我在单元格的鼠标悬停时插入一个图片作为弹出窗口。

我通过在单元格中插入注释并将注释的填充设置为指定的图片来实现此目的。

我希望图片保持原始缩放

设置评论后使用图片作为填充背景，我可以手动右键单击该单元格，单击编辑评论，右键单击评论，转到“大小”选项卡，选择“相对于原始图片大小“复选框，并将比例高度和大小设置为100％，从而达到预期效果，如下所示：

录制宏以查看要复制此内容的VBA会导致无法录制任何内容。

使用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 Image Acquisition Automation Layer访问image file's dimensions。

以下示例访问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