導出設置的評論的圖片填充

Question

我已經使用了一些代碼，將允許用戶使用存儲在單元格中的意見圖片：

Application.ActiveCell.AddComment.Shape.Fill.UserPicture（FNAME ）

我現在想寫一些迭代通過工作表的註釋並將上面使用的所有圖片導出到單獨的圖片文件。我不知道如何找到正確的對象來做到這一點。

感謝 馬丁

Answer 1

我從幾個來源拼湊一些代碼在一起。這個怎麼用？

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 

和 「導出」 子：

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