将图像文件路径作为超链接插入单元格，并将图像本身插入注释

Question

我正在尝试创建一个将一张或多张图片作为输入的 Excel 宏。然后它将图像作为注释添加到选定的单元格。我已经完成了这么多。

接下来我要做的是获取图片的路径并将其作为超链接插入到单元格中。
例如
图片 - \server\share\test\image.jpg
插入图片作为评论
将图片路径作为文本插入

到目前为止，这是我的代码：

Sub ImageLinkComment()

Dim Pict() As Variant
Dim ImgFileFormat As String
Dim PictCell As Range
Dim lLoop As Long
Dim sShape As Picture

ActiveSheet.Protect False, False, False, False, False
ImgFileFormat = "All Picture Files(*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;*.jpe;*.png;*.bpm;*.gif;*.gfa;*.emz;*.wmz;*.pcz;*.tif;*.tiff;*.cgm;*.eps;*.pct;*.pict;*.wpg;*.pcd;*.pcx;*.cdr;*.fpx;*.mix), *.bmp"

 'Note you can load in any nearly file format
Pict = Application.GetOpenFilename(ImgFileFormat, MultiSelect:=True)
If Not IsArray(Pict) Then
    Debug.Print "No files selected."
    Exit Sub
End If

Set PictCell = Selection.Cells(1)
For lLoop = LBound(Pict) To UBound(Pict)

    PictCell.AddComment
    PictCell.Comment.Visible = False
    PictCell.Comment.Shape.Height = 215
    PictCell.Comment.Shape.Width = 195
    PictCell.Comment.Shape.Fill.UserPicture Pict(lLoop)

    Set PictCell = PictCell.Offset(1)
Next lLoop

End Sub

Answer 1

所以，在玩了一些之后，我得到了这段代码，一次只能处理一张图片。它不是最漂亮的，但它很实用。 我将它分配给我的 Excel 工作表中的一个按钮，以及另一个用于清除单元格内容的按钮。

Sub InsertImagesAsComments()

Dim Pict
Dim ImgFileFormat As String
Dim PictCell As Range
Dim lLoop As Long
Dim sShape As Picture

ActiveSheet.Protect False, False, False, False, False
ImgFileFormat = "All Picture Files(*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;*.jpe;*.png;*.bpm;*.gif;*.gfa;*.emz;*.wmz;*.pcz;*.tif;*.tiff;*.cgm;*.eps;*.pct;*.pict;*.wpg;*.pcd;*.pcx;*.cdr;*.fpx;*.mix), *.bmp"

 'Note you can load in any nearly file format

Pict = Application.GetOpenFilename(ImgFileFormat, MultiSelect:=False)
If Pict = False Then Exit Sub

Set PictCell = Selection.Cells(1)

PictCell.AddComment
PictCell.Comment.Visible = False
PictCell.Comment.Shape.Height = 215
PictCell.Comment.Shape.Width = 195
PictCell.Comment.Shape.Fill.UserPicture Pict
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
    Pict, _
    TextToDisplay:= _
    Pict

End Sub

Answer 2

此代码的目的是从文件路径中获取图像并将它们作为注释放在相邻行中。

假设A1到A5有5个文件路径，代码要求选择范围，然后将图像作为注释放在B1到B5中。

希望对某人有所帮助

Sub Filepath_to_Picture_As_Comments()

Dim cmt As Comment
Dim rng As Range
Dim Workrng As Range
Dim Height As Long
Dim Width As Long

On Error Resume Next

xTitleId = "Select range of File paths"
Set Workrng = Application.Selection
Set Workrng = Application.InputBox("File paths", xTitleId, Workrng.Address, Type:=8)

Height = Application.InputBox("Add text", "Height of comment", "400", Type:=2)
Width = Application.InputBox("Add text", "Width of comment", "500", Type:=2)

For Each rng In Workrng
  With rng.Offset(0, 1)
    Set cmt = rng.Comment
    If cmt Is Nothing Then
      Set cmt = .AddComment
    End If
    With cmt
      .Text Text:=""
      .Shape.Fill.UserPicture rng.Value
      .Visible = False
    End With
  End With
Next rng

For Each cmt In Application.ActiveSheet.Comments
    cmt.Shape.Width = Width
    cmt.Shape.Height = Height
Next cmt

End Sub