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

Change comment size relative to original size of fill picture in Excel vba

正在尝试编写 VBA excel 宏,允许我在鼠标悬停在单元格上时插入图片作为弹出窗口。

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

我希望图片保持原来的缩放比例

设置评论使用图片作为填充背景后,我可以手动右击单元格,点击编辑评论,右击评论,进入"size"标签,select "Relative to original picture size"复选框,设置比例尺高度和尺寸为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 访问对话框中的内容???

可以使用评论显示缩放后的图像。诀窍是自己计算比例因子并将其应用于图像。我用过 Windows Image Acquisition Automation Layer to access the 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