vba - 在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