繁体   English   中英

将 PowerPoint 演示文稿中的评论导出到 Word 文档的表格中

[英]Export comments from a PowerPoint presentation in a table of a Word document

我的目的是使用 VBA 代码从 PowerPoint 文档中提取评论并将信息粘贴到 Word 中的表格中。

我开始构建适用于 Word 的代码,并尝试适应 PowerPoint。 不幸的是,我遇到了一些错误,例如 Error 07 memory 问题,而代码可以完美地从 word 文档中提取评论...

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

有高人可以帮我验证一下代码吗? 为了便于阅读,我在代码中做了注释。

PS:在PowerPoint VBA Editor中,我确实启用了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

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

ActivePresentation.Comments.Count

因为 Comments 不是 Presentation 属性。 而且,一旦你克服了这个障碍,你的代码就会失败:

.Scope.Information(wdActiveEndPageNumber)

因为 PowerPoint Comments 没有 scope 属性,即使有,'.Information(wdActiveEndPageNumber)' 指的是 Word 常量,而不是 PowerPoint 常量。

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

有关帮助您正确起步的一些代码,请参阅: http://www.pptfaq.com/FAQ00900_Export_comments_to_a_text_file_-PowerPoint_2002_and_later-.htm

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM