I'm trying to create an Excel macro that takes a picture or pictures as input. It then adds the image as a comment to the selected cell. I have this much complete.
What I want to do next is take the path of the picture and insert it as a hyperlink in the cell.
eg
Image - \\server\\share\\test\\image.jpg
Insert image as comment
Insert image path as text
Here is my code so far:
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
So, after some playing around I got this code to work for one image at a time. It's not the prettiest but it's functional. I assigned it to a button within my excel sheet, along with another button to clear the contents of a cell.
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
Purpose of this code is to fetch the images from the file path and place them as comment in the adjacent row.
Assummning there are 5 file path in A1 to A5, the code asks to select the range, and then it puts the image as comment in B1 to B5.
Hope it helps someone
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.