[英]Export Powerpoint comments to Excel
我正在嘗試創建一個宏來將Powerpoint注釋導出到Excel中,其中包含不同標題的列,如作者,幻燈片編號等。
嘗試使用我的Word代碼為這個宏,它工作正常,但在VBA新手,我不知道如何為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
輸出是一個新的Excel工作簿,其中包含一個工作表和7列,顯示注釋編號,頁碼,審閱者姓名縮寫,審閱者姓名,寫日期,注釋文本和章節(標題)
以下是您可以使用上述代碼進行調整的示例。 它會逐步瀏覽所有幻燈片,並捕獲每張幻燈片上的所有注釋。
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
編輯:更新的代碼顯示將注釋數據保存到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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.