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

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

2 个答案: