Exporting a picture set as a comment fill - excel

Question

I have used some code that will allow a user to store a picture in the comments of a cell using:
Application.ActiveCell.AddComment.Shape.Fill.UserPicture (fName)
I now want to write something that iterates through the comments of a worksheet and exports all the pictures used above into separate picture files. I am not sure how to reach the right object to do this.
Thanks
Martin

Answer 1

I cobbled some code together from a few sources. How does this work?
Sub extractCommentImage()
'Borrowed from: https://excelribbon.tips.net/T011165_Moving_Comment_Background_Pictures_to_Cells.html
Dim cmt As Comment
Dim cel As Range
Dim bvisible As Boolean
For Each cmt In ActiveSheet.Comments
With cmt
bvisible = .Visible
.Visible = True
Set cel = .Parent.Offset(0, 1)
.Shape.CopyPicture appearance:=xlScreen, Format:=xlPicture
cel.PasteSpecial
selection.ShapeRange.LockAspectRatio = msoFalse
.Visible = bvisible
.Shape.Fill.OneColorGradient msoGradientFromCenter, 1, 1
End With 'cmt
Next cmt
ExportMyPicture
End Sub
And the "Export" sub:
Sub ExportMyPicture()
'borrowed from: https://stackoverflow.com/questions/18232987/export-pictures-from-excel-file-into-jpg-using-vba
Dim MyChart As String, MyPicture As String, pic As Object
Dim PicWidth As Long, PicHeight As Long, num As Long
Dim shtName as String
num = 1
Application.ScreenUpdating = False
shtName = ActiveSheet.Name
For Each pic In ActiveSheet.Pictures
MyPicture = pic.Name
With pic
PicHeight = .ShapeRange.Height
PicWidth = .ShapeRange.Width
End With
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:=shtName
selection.Border.LineStyle = 0
MyChart = Split(ActiveChart.Name, " ")(1) & " 1"
With ActiveSheet
With .Shapes(MyChart)
.Width = PicWidth
.Height = PicHeight
End With
.Shapes(MyPicture).Copy
With ActiveChart
.ChartArea.Select
.Paste
End With
.ChartObjects(1).Chart.Export Filename:="C:\Users\[CHANGE THIS]\Desktop\MyPic " & num & ".jpg", FilterName:="jpg"
num = num + 1
.Shapes(MyChart).Cut
End With
Next pic
Application.ScreenUpdating = True
Exit Sub
End Sub