Export Powerpoint comments to Excel

问题

I am trying to create a macro to export Powerpoint comments into Excel, with columns for different headings such as author, slide number etc.

Tried using the code I have for Word for this macro, which works fine, however being a novice at VBA I don't know how to customise this code for Powerpoint

Sub ExportWordComments()

' Purpose: Search for comments in any text that's been pasted into
' this document, then export them into a new Excel spreadsheet.
' Requires reference to Microsoft Excel 15.0 Object Library in VBA,
' which should already be saved with as part of the structure of
' this .docm file.

Dim bResponse As Integer

' Exit routine if no comments have been found.
If ActiveDocument.Comments.Count = 0 Then
  MsgBox ("No comments found in this document")
  Exit Sub
Else
  bResponse = MsgBox("Do you want to export all comments to an Excel worksheet?", _
              vbYesNo, "Confirm Comment Export")
  If bResponse = 7 Then Exit Sub
End If

' Create a object to hold the contents of the
' current document and its text. (Shorthand
' for the ActiveDocument object.
Dim wDoc As Document
Set wDoc = ActiveDocument

' Create objects to help open Excel and create
' a new workbook behind the scenes.
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook

Dim i As Integer
Dim oComment As Comment         'Comment object

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False

' Create a new Workbook. Shouldn't interfere with
' other Workbooks that are already open. Will have
' at least one worksheet by default.
Set xlWB = xlApp.Workbooks.Add

With xlWB.Worksheets(1).Range("A1")

  ' Create headers for the comment information
  .Offset(0, 0) = "Comment Number"
  .Offset(0, 1) = "Page Number"
  .Offset(0, 2) = "Reviewer Initials"
  .Offset(0, 3) = "Reviewer Name"
  .Offset(0, 4) = "Date Written"
  .Offset(0, 5) = "Comment Text"
  .Offset(0, 6) = "Section"

  ' Export the actual comments information
  For i = 1 To wDoc.Comments.Count
   Set oComment = wDoc.Comments(i)
   Set rngComment = oComment.Reference
   rngComment.Select
   Set rngHeading = wDoc.Bookmarks("\HeadingLevel").Range
   rngHeading.Collapse wdCollapseStart
   Set rngHeading = rngHeading.Paragraphs(1).Range
  .Offset(i, 0) = oComment.Index
  .Offset(i, 1) = oComment.Reference.Information(wdActiveEndAdjustedPageNumber)
  .Offset(i, 2) = oComment.Initial
  .Offset(i, 3) = oComment.Author
  .Offset(i, 4) = Format(oComment.Date, "mm/dd/yyyy")
  .Offset(i, 5) = oComment.Range
  .Offset(i, 6) = rngHeading.ListFormat.ListString & " " & rngHeading.Text
Next i

End With

' Make the Excel workbook visible
xlApp.Visible = True

' Clean up our objects
Set oComment = Nothing
Set xlWB = Nothing
Set xlApp = Nothing
End Sub

The output is a new Excel workbook with a sheet and 7 columns that show the Comment Number, Page Number, Reviewer Initials, Reviewer Name, Date Written, Comment Text and Section (Heading)

回答1:

Here's an example you can adapt with your code above. It steps through all the slides, and catches all the comments on each slide.

Option Explicit

Sub ExportPowerpointComments()
    Dim slideNumber As Long
    Dim commentNumber As Long

    Dim thisSlide As Slide
    For Each thisSlide In ActivePresentation.Slides
        slideNumber = thisSlide.slideNumber
        Dim thisComment As Comment
        For Each thisComment In thisSlide.Comments
            commentNumber = commentNumber + 1
            With thisComment
                Debug.Print commentNumber & vbTab;
                Debug.Print slideNumber & vbTab;
                Debug.Print .AuthorInitials & vbTab;
                Debug.Print .Author & vbTab;
                Debug.Print Format(.DateTime, "dd-mmm-yyyy hh:mm") & vbTab;
                Debug.Print .Text & vbTab
            End With
        Next thisComment
    Next thisSlide
End Sub

EDIT: updated code to show saving the comment data to Excel

Option Explicit

Sub ExportPointpointComments()
    ' Create objects to help open Excel and create
    ' a new workbook behind the scenes.
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook

    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False

    ' Create a new Workbook. Shouldn't interfere with
    ' other Workbooks that are already open. Will have
    ' at least one worksheet by default.
    Set xlWB = xlApp.Workbooks.Add

    With xlWB.Worksheets(1).Range("A1")
        ' Create headers for the comment information
        .Offset(0, 0) = "Comment Number"
        .Offset(0, 1) = "Slide Number"
        .Offset(0, 2) = "Reviewer Initials"
        .Offset(0, 3) = "Reviewer Name"
        .Offset(0, 4) = "Date Written"
        .Offset(0, 5) = "Comment Text"
        .Offset(0, 6) = "Section"

        Dim slideNumber As Long
        Dim commentNumber As Long
        Dim thisSlide As Slide
        For Each thisSlide In ActivePresentation.Slides
            slideNumber = thisSlide.slideNumber
            Dim thisComment As Comment
            For Each thisComment In thisSlide.Comments
                commentNumber = commentNumber + 1
                .Offset(commentNumber, 0) = commentNumber
                .Offset(commentNumber, 1) = slideNumber
                .Offset(commentNumber, 2) = thisComment.AuthorInitials
                .Offset(commentNumber, 3) = thisComment.Author
                .Offset(commentNumber, 4) = Format(thisComment.DateTime, "dd-mmm-yyyy hh:mm")
                .Offset(commentNumber, 5) = thisComment.Text
            Next thisComment
        Next thisSlide
    End With

    ' Make the Excel workbook visible
    xlApp.Visible = True

    ' Clean up our objects
    Set xlWB = Nothing
    Set xlApp = Nothing
End Sub

来源：https://stackoverflow.com/questions/55616989/export-powerpoint-comments-to-excel