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

我正在尝试在包含图像的Excel中创build一个数据库。 要做到这一点，最好的办法似乎是用图片的评论作为评论的背景。 不幸的是，我有大约100个观察点，这会花费一些时间。

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

本质上，我需要：

1. 为给定的单元格创build注释
2. 从任务中删除任何文本
3. 从评论中删除任何线条边框
4. 将注释的尺寸调整为宽度= 5英寸和高度= 6.5英寸。
5. 用指定的图像填充背景。

现在，我需要使用的所有图像都在特定的文件夹中。 我已经包含在一个调用中的文件名旁边的单元格，我试图添加评论。

所以，我不完全确定如何在VBA中完成以上任务。 我已经开始logging一个macros，它产生了一些我修改过的代码，用来对多个单元格做同样的事情。 唯一的是，我需要它为每个评论的背景使用不同的图像 。 我怎么能做到这一点？ 似乎我需要设置某种循环来遍历所有的单元格。 然后，为了改变背景的步骤，我需要使用下一个单元格的值来指定我想要使用的图片的位置。

不幸的是，我的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

以下演示如何做到这一点。 macroslogging器已经给你80％的所需的方法 – 所需要的只是一些清理（logging器吐出大量的垃圾），并改变一些位的方法参数。

下面显示了一个对话框来select你的图像，然后，从活动单元格开始，按照您的要求逐步将每个图像分配给单元格注释。

 '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