将 Powerpoint 评论导出到 Excel [英] Export Powerpoint comments to Excel

问题描述

我正在尝试创建一个宏以将 Powerpoint 评论导出到 Excel，其中包含针对不同标题(如作者、幻灯片编号等)的列.

尝试使用我为这个宏编写的 Word 代码，效果很好，但是作为 VBA 的新手，我不知道如何为 Powerpoint 自定义此代码

Sub ExportWordComments()' 目的:在粘贴到的任何文本中搜索评论' 此文档，然后将它们导出到一个新的 Excel 电子表格中.' 需要在 VBA 中引用 Microsoft Excel 15.0 对象库，' 应该已经保存为结构的一部分' 这个 .docm 文件.Dim bResponse 作为整数' 如果没有找到注释，则退出例程.如果 ActiveDocument.Comments.Count = 0 那么MsgBox ("在此文档中未找到任何评论")退出子别的bResponse = MsgBox("是否要将所有评论导出到 Excel 工作表?", _vbYesNo, "确认评论导出")如果 bResponse = 7 然后退出子万一' 创建一个对象来保存内容' 当前文档及其文本.(速记' 用于 ActiveDocument 对象.将 wDoc 作为文档变暗设置 wDoc = ActiveDocument' 创建对象以帮助打开 Excel 并创建'幕后的新工作簿.Dim xlApp 作为 Excel.ApplicationDim xlWB 作为 Excel.WorkbookDim i 作为整数Dim oComment As Comment 'Comment 对象Set xlApp = CreateObject("Excel.Application")xlApp.Visible = False' 创建一个新的工作簿.不应该干涉' 其他已经打开的工作簿.会有' 默认情况下至少有一张工作表.设置 xlWB = xlApp.Workbooks.Add使用 xlWB.Worksheets(1).Range("A1")' 为评论信息创建标题.Offset(0, 0) = "评论号".Offset(0, 1) = "页码".Offset(0, 2) = "审稿人姓名缩写".Offset(0, 3) = "审稿人姓名".Offset(0, 4) = "写日期".Offset(0, 5) = "评论文本".Offset(0, 6) = "节"' 导出实际评论信息对于 i = 1 到 wDoc.Comments.Count设置 oComment = wDoc.Comments(i)设置 rngComment = oComment.ReferencerngComment.Select设置 rngHeading = wDoc.Bookmarks("\HeadingLevel").RangerngHeading.Collapse wdCollapseStart设置 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接下来我结束于' 使 Excel 工作簿可见xlApp.Visible = True' 清理我们的对象设置 oComment = 无设置 xlWB = 无设置 xlApp = 无结束子

输出是一个新的 Excel 工作簿，其中包含一个工作表和 7 列，显示评论编号、页码、审稿人姓名缩写、审稿人姓名、撰写日期、评论文本和部分(标题)

解决方案

这是一个示例，您可以使用上面的代码进行调整.它会逐步浏览所有幻灯片，并捕获每张幻灯片上的所有评论.

选项显式子导出PowerpointComments()Dim slideNumber As LongDim commentNumber As Long将此幻灯片调暗为幻灯片对于 ActivePresentation.Slides 中的每个 thisSlideslideNumber = thisSlide.slideNumber将此评论调暗为评论For each thisComment In thisSlide.Comments评论编号 = 评论编号 + 1有了这个评论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 &标签页结束于下一条评论下一张幻灯片结束子

<块引用>

更新代码以显示将评论数据保存到 Excel

选项显式Sub ExportPointpointComments()' 创建对象以帮助打开 Excel 并创建'幕后的新工作簿.Dim xlApp 作为 Excel.ApplicationDim xlWB 作为 Excel.WorkbookSet xlApp = CreateObject("Excel.Application")xlApp.Visible = False' 创建一个新的工作簿.不应该干涉' 其他已经打开的工作簿.会有' 默认情况下至少有一张工作表.设置 xlWB = xlApp.Workbooks.Add使用 xlWB.Worksheets(1).Range("A1")' 为评论信息创建标题.Offset(0, 0) = "评论号".Offset(0, 1) = "幻灯片编号".Offset(0, 2) = "审稿人姓名缩写".Offset(0, 3) = "审稿人姓名".Offset(0, 4) = "写日期".Offset(0, 5) = "评论文本".Offset(0, 6) = "节"Dim slideNumber As LongDim commentNumber As Long将此幻灯片调暗为幻灯片对于 ActivePresentation.Slides 中的每个 thisSlideslideNumber = thisSlide.slideNumber将此评论调暗为评论For each thisComment In thisSlide.Comments评论编号 = 评论编号 + 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下一条评论下一张幻灯片结束于' 使 Excel 工作簿可见xlApp.Visible = True' 清理我们的对象设置 xlWB = 无设置 xlApp = 无结束子

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)

解决方案

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

这篇关于将 Powerpoint 评论导出到 Excel的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！