Question

我没有成功地搜索过如何做到这一点......任何帮助都非常感激。

我编写了一个VBA宏，它将通过MS Word文档，识别每个版本（例如，删除/插入），并将修改后的文本放入新Word文档的表中。在附加表格列中，我添加了其他相关信息，如原始（修订前）文本，修订版的名称/首字母，修订版的页码等。

我想做同样的事情，但将信息放入Excel而不是，，同时保留修订版的格式（下划线=插入，删除线=删除）。我知道这一定是可能的，因为当我'手动'将我的新'修订表'复制并粘贴到Excel中时，我想要保留的格式。但是当我尝试编写这一步时，情况就不会发生了。我手动剪切和粘贴尝试录制宏，但它并没有真正帮助。

以下是将信息放入新Word文档的代码：

 Sub TabulateRevisions()
        Dim oDoc As Document, nDoc As Document
        Dim PP As Paragraph
        Dim SS As Range
        Dim RR As Revision
        Dim r As Long, n As Long
        r = 2
        n = 1


Set oDoc = ThisDocument
    oDoc.ActiveWindow.View.MarkupMode = wdInLineRevisions
        'Need to set this off so the cut and paste gets carries teh inserts and deletions
        If oDoc.TrackRevisions = True Then
            oDoc.TrackRevisions = False
        End If

        Documents.Add
Set nDoc = ActiveDocument
nDoc.PageSetup.Orientation = wdOrientLandscape
        nDoc.Tables.Add nDoc.Range, 1, 10

    For Each PP In oDoc.Paragraphs
            For Each SS In PP.Range.Sentences
                For Each RR In SS.Revisions
                    'If RR.Type = 1 Or RR.Type = 2 Then 'uncomment to restrict revision types
                    SS.Select
                    On Error Resume Next 'this is just to prevent an error message telling me 'selection is marked as deleted'
                    SS.Copy

                    nDoc.Tables(1).Rows.Add
                    nDoc.Tables(1).Cell(r, 1).Range.Select
                    Selection.PasteAndFormat(wdFormatOriginalFormatting)
                    nDoc.Tables(1).Cell(r, 2).Range.Select
                    Selection.PasteAndFormat(wdFormatOriginalFormatting)
                    nDoc.Tables(1).Cell(r, 3).Range.Text = SS.Text
                    nDoc.Tables(1).Cell(r, 4).Range.Text = RR.Range.Text
                    nDoc.Tables(1).Cell(r, 6).Range.Text = r
                    If RR.Type = 1 Then
                        nDoc.Tables(1).Cell(r, 7).Range.Text = "insertion"
                    ElseIf RR.Type = 2 Then
                        nDoc.Tables(1).Cell(r, 7).Range.Text = "deletion"
                    End If
                    r = r + 1
                    ' End If
                Next RR
            Next SS
        Next PP

        'Code below rejects all revisions in col 2 of nDoc table--these remain in col 1
        Dim CC As Cell
        For Each CC In nDoc.Tables(1).Columns(2).Cells
            n = n + 1
            For Each RR In CC.Range.Revisions
                RR.Reject
            Next RR
        Next CC
    End Sub

抱歉;那有点长。我试图调整这段代码，这样它就不会创建一个新的Word文档，而是打开一个Excel wb并将信息放在那里。对于没有问题的非格式化信息，但我无法弄清楚如何保留格式，就像我在我的nDoc.Tables（1）的col 1中所做的那样。我尝试了各种方法，例如：

xlWB.worksheets(1).Cells(r, 1).Select 'or:
xlWB.worksheets(1).Cells(r, 1).Activate 'followed by:
ActiveSheet.Range.PasteAndFormat (wdFormatOriginalFormatting) 'and various other permutations of Word style commands
'or:
ActiveSheet.Range.PasteSpecial xlPasteAll 'and various other permutations of Excel-style commands

我甚至试图编写代码来简单地将我的nDoc.Tables（1）复制并粘贴到Excel中（因为这实际上在我手动操作时有效），但没有成功。

有什么建议吗？我应该提一下，我有Office 2010，Windows 8。

感谢所有读过这篇文章的人！

使用VBA将MS Word修订粘贴到Excel中，从而保持格式化

0 个答案: