Question

我正在尝试在Excel中创建包含图像的数据库。这样做的最佳方式似乎是使用带有图片的评论作为评论的背景。不幸的是，我有大约100个观察结果，这将耗费一些时间。

我对VBA很新。我知道Python和Matlab，但我刚刚开始使用VBA。

基本上，我需要：

为给定单元格创建评论
从商品中删除任何文字
从评论中删除任何行边框
将注释的尺寸调整为width = 5英寸和高度 = 6.5英寸。
使用指定的图像填充背景。

现在，我需要使用的所有图像都在特定的文件夹中。我已将文件名包含在与我正在尝试添加注释的单元格相邻的调用中。

所以，我不确定如何在VBA中完成上述操作。我开始记录一个宏，它产生了一些代码，我修改了这些代码，用多个单元格做同样的事情。唯一的问题是，我需要使用不同的图像作为每个评论的背景。我怎么能做到这一点？看起来我需要设置某种循环来遍历所有单元格。然后，对于更改背景的步骤，我需要使用下一个单元格的值来指定我想要使用的图片的位置。

不幸的是，我的VBA技能并不能完全应对这一挑战。任何帮助将不胜感激。

Sub Macro3()
'
' Macro3 Macro
'
' Keyboard Shortcut: Option+Cmd+g


'    Range("C25:C50").AddComment
'    Range("C25:C50").Comment.Visible = False
'    Range("C25:C50").Comment.Shape.Select True
'    Range("C25:C50").Comment.Text Text:="" & Chr(13) & ""
'    Selection.ShapeRange.Line.Weight = 0.75
'    Selection.ShapeRange.Line.DashStyle = msoLineSolid
'    Selection.ShapeRange.Line.Style = msoLineSingle
'    Selection.ShapeRange.Line.Transparency = 0#
'    Selection.ShapeRange.Line.Visible = msoFalse
'    Selection.ShapeRange.Fill.Visible = msoTrue
'    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
'    Selection.ShapeRange.Fill.BackColor.RGB = RGB(251, 254, 130)
'    Selection.ShapeRange.Fill.Transparency = 0#
'    Selection.ShapeRange.Fill.UserPicture _
'        "OWC Mercury Extreme Pro:Users:austinwismer:Desktop:Flange:IMG_2626.JPG"
'    Selection.ShapeRange.LockAspectRatio = msoFalse
'    Selection.ShapeRange.Height = 468#
'    Selection.ShapeRange.Width = 360#
End Sub

Answer 1

下面演示了如何做到这一点。 Macro Recorder已经为您提供了80％的必需方法 - 所需要的只是一些清理（记录器吐出大量垃圾）并将一些位更改为方法参数。

下面显示了一个用于选择图像的对话框，然后从“活动单元格”开始，逐步将每个图像分配给您的要求中指定的单元格注释。

'There are lots of ways to get teh filepaths. The below just demonstrate two ways.

Sub Example_UsingSelection()
    Dim cell As Range
    For Each cell In Selection
        SetCommentPicture cell.Offset(0, 1), cell.Value
    Next cell
End Sub

Sub Example_UsingFileDialog()
    Dim cell As Range
    Dim item

    Set cell = ActiveCell

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Title = "Select images"
        .ButtonName = "Select"
        .Show
        For Each item In .SelectedItems
            SetCommentPicture cell, CStr(item)
            Set cell = cell.Offset(1, 0)
        Next item
    End With

End Sub

Sub SetCommentPicture(cell As Range, imagePath As String)

    Dim cm As Comment

    'Get the comment
    If cell.Comment Is Nothing Then
        Set cm = cell.AddComment
    Else
        Set cm = cell.Comment
    End If

    'Clear any text
    cm.Text ""

    'Set comment properties (dimensions & picture)
    With cm.Shape
        .Width = Application.InchesToPoints(5)
        .Height = Application.InchesToPoints(6.5)
        .Line.Visible = msoFalse
        .Fill.UserPicture (imagePath)
    End With

End Sub

以编程方式将图片插入单元格注释

1 个答案: