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

问题描述 投票:0回答:2

我正在尝试创建一个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
image excel-vba filepath vba excel
2个回答
0
投票

所以,经过一些游戏,我得到了这个代码一次为一个图像工作。它不是最漂亮的,但它的功能。我将它分配给我的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

0
投票

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

假设在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
© www.soinside.com 2019 - 2024. All rights reserved.