从PowerPoint演示文稿中的Word文档表中导出注释

Question

我的意图是使用VBA代码从PowerPoint文档中提取注释并将信息粘贴到Word中的表中。

我开始构建可在Word上使用的代码，并试图适应与PowerPoint一起使用。不幸的是，我遇到了一些错误，例如错误07内存问题，而代码可以完美地从Word文档中提取注释...

我迷路了，不知道该怎么办...

是否有专家可以帮助我验证代码？我在代码中做了注释，以使其易于阅读。

PS：在PowerPoint VBA编辑器中，我确实为Word启用了引用。

Sub Tansfer_PPT_comments_in_WordDoc()

Dim n As Long
Dim nCount As Long
Dim ppt As Presentation
Dim wdapp As Word.Application
Dim wddoc As Word.Document
Dim wdtable As Table

Set ppt = ActivePresentation
nCount = ActivePresentation.Comments.Count

'Open a Word document
On Error Resume Next

Set wdapp = GetObject(, "Word.Application")
If Err.Number <> 0 Then 'Word isn't already running
    Set wdapp = CreateObject("Word.Application")
End If

On Error GoTo 0

'Create word page with landscape orientation
Set wddoc = Documents.Add
    wddoc.PageSetup.Orientation = wdOrientLandscape

'Insert a 5-column table
With wddoc
    .Content = ""
    Set wdtable = .Tables.Add _
        (Range:=Selection.Range, _
        Numrows:=nCount + 1, _
        NumColumns:=5)
End With

'DOCUMENT FORMATTING

'Define Normal and Header style
With wddoc.Styles(wdStyleNormal)
    .Font.Name = "Arial"
    .Font.Size = 10
    .ParagraphFormat.LeftIndent = 0
    .ParagraphFormat.SpaceAfter = 6
End With

With wddoc.Styles(wdStyleHeader)
    .Font.Size = 8
    .ParagraphFormat.SpaceAfter = 0
End With

'Format table
With wdtable
    .Range.Style = wdStyleNormal
    .AllowAutoFit = False
    .PreferredWidthType = wdPreferredWidthPercent
    .PreferredWidth = 100
    .Columns(1).PreferredWidth = 2
    .Columns(2).PreferredWidth = 20
    .Columns(3).PreferredWidth = 40
    .Columns(4).PreferredWidth = 8
    .Columns(5).PreferredWidth = 40
    .Rows(1).HeadingFormat = True

    .Columns(1).Select
        Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

    .Rows(1).Select
        Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
        Selection.Font.ColorIndex = wdDarkBlue
        Selection.Shading.Texture = wdTextureNone
        Selection.Shading.ForegroundPatternColor = wdColorAutomatic
        Selection.Shading.BackgroundPatternColor = -603937025
    End With

'Add table borders
With wdtable.Borders
    .InsideLineStyle = Options.DefaultBorderLineStyle
    .InsideLineWidth = Options.DefaultBorderLineWidth
    .InsideColor = Options.DefaultBorderColor
    .OutsideLineStyle = Options.DefaultBorderLineStyle
    .OutsideLineWidth = Options.DefaultBorderLineWidth
    .OutsideColor = Options.DefaultBorderColor
End With

'DOCUMENT CONTENT

'Define table headings names
With wdtable.Rows(1)
    .Range.Font.Bold = True
    .Cells(1).Range.Text = "Page"
    .Cells(2).Range.Text = "Comment scope"
    .Cells(3).Range.Text = "Comment text"
    .Cells(4).Range.Text = "Author"
    .Cells(5).Range.Text = "Parexel response"
End With

'Insert information from the comments in ppt into the wddoc table
For n = 1 To nCount
    With wdtable.Rows(n + 1)
        'Page number
        .Cells(1).Range.Text = _
        ppt.Comments(n).Scope.Information(wdActiveEndPageNumber)
        'The text marked by the comment
        .Cells(2).Range.Text = ppt.Comments(n).Scope
        'The comment itself
        .Cells(3).Range.Text = ppt.Comments(n).Range.Text
        'The comment author
        .Cells(4).Range.Text = ppt.Comments(n).Author
    End With
Next n

ScreenUpdating = True
Application.ScreenRefresh

wddoc.Activate

Set ppt = Nothing
Set wddoc = Nothing
Set wdtable = Nothing

End Sub

Answer 1

您的代码将在以下位置失败：

ActivePresentation.Comments.Count

因为注释不是Presentation属性。而且，一旦克服了这一障碍，您的代码将在以下位置失败：

.Scope.Information(wdActiveEndPageNumber)

由于PowerPoint注释没有作用域属性，即使它们具有作用域属性，'。Information（wdActiveEndPageNumber）'也指向Word常量，而不是PowerPoint常量。

您不能简单地采用适用于一个应用程序的VBA方法，属性和常量，并假定它们以相同的方式适用于另一应用程序。您需要使用有效的PowerPoint方法，属性和常量来开发PowerPoint代码。