Exporting a picture set as a comment fill

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

score 0 · Accepted Answer · answered Apr 17 '17 at 16:01

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

Many thanks. I had to change it around a bit but your code was perfect for pointing me in the right direction. I owe you a beer — Martin Williams, Apr 19 '17 at 22:40

Exporting a picture set as a comment fill

1 Answers1