Hi all,

I am working on a database ahich involves a large amount of pictures. I have these pictures linked to the document and for each of these hyperlinks I have a comment box which has a preview of the photo. I need help with creating a macro to do this automatically as I have 1000 more files. The pictures are in numerical order but they start with filename (430).jpg. Help is much appreciated.

Thanks,
Dr. Mike

Here is my attempt at creating a macro for this. It does not work at all for the comments or for doing all the files, but it works for the first hyperlinks.

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="packs/(429).jpg", _
TextToDisplay:="packs\(429).jpg"
Range("B430").AddComment
Range("B430").Comment.Visible = False
Range("B430").Comment.Text Text:=""
With Selection.Font
.Name = "Tahoma"
.FontStyle = "Bold"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.ShapeRange.Fill.Transparency = 0#
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.SchemeColor = 80
Selection.ShapeRange.Fill.UserPicture _
"S:\Visibilité\Promo Pack1\Etude pack\packs\(429).jpg"
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 255#
Selection.ShapeRange.Width = 255#
Range("B431").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="packs/(430).JPG", _
TextToDisplay:="packs\(430).JPG"
Range("B431").AddComment
Range("B431").Comment.Visible = False
Range("B431").Comment.Text Text:=""
With Selection.Font
.Name = "Tahoma"
.FontStyle = "Bold"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.ShapeRange.Fill.Transparency = 0#
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.SchemeColor = 80
Selection.ShapeRange.Fill.UserPicture _
"S:\Visibilité\Promo Pack1\Etude pack\packs\(430).JPG"
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 255#
Selection.ShapeRange.Width = 255#
Range("B432").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="packs/(431).jpg", _
TextToDisplay:="packs\(431).jpg"
Range("B432").AddComment
Range("B432").Comment.Visible = False
Range("B432").Comment.Text Text:=""
With Selection.Font
.Name = "Tahoma"
.FontStyle = "Bold"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.ShapeRange.Fill.Transparency = 0#
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.SchemeColor = 80
Selection.ShapeRange.Fill.UserPicture _
"S:\Visibilité\Promo Pack1\Etude pack\packs\(431).jpg"
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 255#
Selection.ShapeRange.Width = 255#
Range("B433").Select
End Sub