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

Question

我有一个代码块，仅在运行多次时才生成格式错误。

该应用程序的目的是从另一个文档复制 table 行并将其粘贴到主文档中的特定 table 中。在另一份文件中，除了这一 table 行之外别无其他。

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

截图：

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 行完全按照您的要求执行。它将转到 table 中的第一行文本并在该行文本之后插入。更有可能的是，在选择 table 之后，您需要折叠范围，以便在 table.

的末尾插入

看看下面的代码。我建议使用 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

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

Inserting a selection from another file into a table - Format error on repetition

automation

vba

ms-word