将另一个文件中的选择插入表格 - 重复时出现格式错误

Question

我有一段代码在多次运行时只会产生格式错误。

该应用程序的目的是从另一个文档中复制表格行并将其粘贴到主文档中的特定表格中。在另一个文档中，除了此表行之外没有其他内容。

现在的错误如下： 该表有两列。第一行被正确附加，但第二行作为一个完整的块粘贴到第一个单元格中，因此第二列既没有创建也没有填充。如果我追加更多行，它们总是嵌套并插入到第一个单元格中。

截图：

Dim wddoc As Document

If CheckBox700400.Value = True Then
    Set wddoc = Documents.Open(file1)
    wddoc.Activate
    With ActiveDocument:
        Selection.WholeStory
        Selection.Copy
    End With
    ThisDocument.Activate
    With Selection:
        .GoTo what:=wdGoToTable, Count:=4
        .GoTo what:=wdGoToLine
        .PasteAndFormat (wdTableAppendTable)
    End With
    wddoc.Close
End If

If CheckBox700300.Value = True Then
    Set wddoc = Documents.Open(file2)
    wddoc.Activate
    With ActiveDocument:
        Selection.WholeStory
        Selection.Copy
    End With
    ThisDocument.Activate
    With Selection:
        .GoTo what:=wdGoToTable, Count:=4
        .GoTo what:=wdGoToLine
        .PasteAndFormat (wdTableAppendTable)
    End With
    wddoc.Close
End If

感谢您的帮助！

Answer 1

Goto 行完全按照您的要求执行。它将转到表格中的第一行文本并在该文本行之后插入。更有可能的是，在选择表格后，您需要折叠范围以便在表格末尾插入。

看看下面的代码。我建议使用 F8 单步执行您的代码和下面的代码，然后对下面的代码进行任何必要的调整，以使其完全按照您的意愿行事。

Dim myDoc As Word.Document
    Set myDoc = ActiveDocument
    
    Dim wddoc As Word.Document
    Dim myRange As Word.Range
    
    If CheckBox700400.Value = True Then
    
        Set wddoc = Documents.Open(file1)
        wddoc.StoryRanges(wdMainTextStory).Copy
            
        Set myRange = myDoc.Tables.Item(4).Range
        myRange.Collapse direction:=wdCollapseEnd
        myRange.PasteAndFormat wdTableAppendTable
        
        wddoc.Close
        
    End If

    If CheckBox700300.Value = True Then
    
        Set wddoc = Documents.Open(file2)
        wddoc.StoryRanges(wdMainTextStory).Copy
            
        Set myRange = myDoc.Tables.Item(4).Range
        myRange.Collapse direction:=wdCollapseEnd
        myRange.PasteAndFormat wdTableAppendTable
        
        wddoc.Close
        
    End If

Answer 2

例如：

Dim DocSrc As Document, DocTgt As Document, Rng As Range
Set DocTgt = ActiveDocument

If CheckBox700400.Value = True Then
    Set DocSrc = Documents.Open(file1)
    DocSrc.Tables(1).Range.Copy
    Set Rng = DocTgt.Tables(4).Range
    Rng.Collapse wdCollapseEnd
    Rng.PasteAndFormat (wdTableAppendTable)
    DocSrc.Close
End If

If CheckBox700300.Value = True Then
    Set DocTgt = Documents.Open(file2)
    DocSrc.Tables(1).Range.Copy
    Set Rng = DocTgt.Tables(4).Range
    Rng.Collapse wdCollapseEnd
    Rng.PasteAndFormat (wdTableAppendTable)
    DocSrc.Close
End If

或者，如果两个表具有相同的格式：

Dim DocSrc As Document, DocTgt As Document, Rng As Range
Set DocTgt = ActiveDocument

If CheckBox700400.Value = True Then
    Set DocSrc = Documents.Open(file1)
    Set Rng = DocTgt.Tables(4).Range
    Rng.Collapse wdCollapseEnd
    Rng.FormattedText = DocSrc.Tables(1).Range.FormattedText
    DocSrc.Close
End If

If CheckBox700300.Value = True Then
    Set DocTgt = Documents.Open(file2)
    Set Rng = DocTgt.Tables(4).Range
    Rng.Collapse wdCollapseEnd
    Rng.FormattedText = DocSrc.Tables(1).Range.FormattedText
    DocSrc.Close
End If