Excel VBA 宏：创建注释框并插入全尺寸图片

Question

为了在 Excel 中装饰测量表，我需要添加许多分配给行的图片。在不调整行大小的情况下，唯一的选择是将每张图片添加到鼠标悬停时显示的注释框中。另一个重要的要求是以全尺寸显示图片。默认评论框尺寸太小。 可以手动添加带有图片背景的评论框，但每张图片需要多次点击，这非常耗时。 一个宏会是什么样子，它可以为您提供在单元格上右键单击选项以显示 FileChooser 窗口并将所选图片以全尺寸插入到新创建的注释框中的宏？

Answer 1

我终于制作了这个宏，复制自不同教程的部分内容。希望这也对其他人有帮助。 有了这个，您可以右键单击一个单元格，选择一张图片，它将作为完整尺寸的注释插入。

将此添加到工作表以将宏添加到右键菜单：

Private Sub Workbook_Deactivate()
    On Error Resume Next
        With Application
            .CommandBars("Cell").Controls("CommentPic").Delete
        End With
    On Error GoTo 0
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim cmdBtn As CommandBarButton
        On Error Resume Next
            With Application
                .CommandBars("Cell").Controls("CommentPic").Delete
            Set cmdBtn = .CommandBars("Cell").Controls.Add(Temporary:=True)
            End With

            With cmdBtn
                .Caption = "CommentPic"
                .Style = msoButtonCaption
                .OnAction = "CommentPic"
            End With
        On Error GoTo 0
End Sub

将缩放图片从路径添加到单元格的子方法

Sub CommentPic()
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False          'Only one file
        .InitialFileName = CurDir         'directory to open the window
        .Filters.Clear                    'Cancel the filter
        .Filters.Add Description:="Images", Extensions:="*.*", Position:=1
        .Title = "Choose image"
            If .Show = -1 Then TheFile = .SelectedItems(1) Else TheFile = 0
    End With

Dim myfile As String
myfile = TheFile
With Selection
    '--- delete any existing comment just for testing
    If Not Selection.Comment Is Nothing Then
        Selection.Comment.Delete
    End If
    InsertCommentWithImage Selection, myfile, 1#
    Selection.Value = "IMG"  
End With
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

Answer 2

Sub AddBackgroundPictureToNote() 调光范围 暗淡 cmt 作为评论 将文件路径变暗为字符串

' Select the cell where you want to add the note
Set rng = Application.Selection

' Create a new comment
rng.AddComment

' Set a reference to the comment
Set cmt = rng.Comment

' Open a file dialog to select the image file
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Title = "Select Background Image"
    .Filters.Add "Image Files", "*.jpg;*.jpeg;*.png;*.gif", 1
    If .Show = -1 Then
        filePath = .SelectedItems(1)
    Else
        Exit Sub ' User canceled the file selection
    End If
End With

' Set the image as the background of the comment shape
cmt.Shape.Fill.UserPicture filePath

' Adjust the comment shape size and position as needed
cmt.Shape.Height = 100 ' Adjust height as desired
cmt.Shape.Width = 150 ' Adjust width as desired
cmt.Shape.Left = rng.Left
cmt.Shape.Top = rng.Top - cmt.Shape.Height

结束子

使用方法：

运行宏：按Alt+F11打开VBA编辑器，插入新模块，然后粘贴代码。保存宏。 选择单元格：在 Excel 工作表中，选择要添加注释的单元格。 运行宏：通过将宏分配给快捷键或使用 VBA 编辑器中的“运行”按钮来运行宏。 选择图像：将打开一个文件对话框。选择您想要用作背景的图像。 调整评论：您可以手动调整评论的大小和位置以满足您的需要。 附加说明：

图像格式：确保所选图像采用受支持的格式，例如 JPG、JPEG、PNG 或 GIF。 图像大小：图像大小可能会影响评论的外观。您可能需要调整评论的大小或图像的大小以获得所需的外观。 评论可见性：默认情况下，评论可见。您可以使用 VBA 或在 Excel 中手动调整其可见性。 错误处理：考虑在代码中添加错误处理，以处理无效文件路径或文件格式等情况。 此代码提供了一种灵活的方式来向 Excel 工作表中的笔记添加背景图像，使您可以自定义笔记的外观并增强其视觉吸引力。