在两个表格之间插入一个表格答案

【问题标题】：Insert a table in word between two tables在两个表格之间插入一个表格
【发布时间】：2016-03-08 17:38:12
【问题描述】：

我有一个 word 文档，其中包含指向其他 word 文档的超链接的表格，请参见下图。 word文档被分类成组，即每组一张表。

我的问题是，有时人们会弄乱格式，例如在表格之间添加换行符或删除换行符（因此它变为 1,2,3,4 换行符，而不是我的代码要求的 2）或更改为了不按字母顺序排列（很少见，我可以忍受）。

所以最后我的问题是，在这种情况下，我创建了一个新文档 PL_xxxx 并且表 PL 不存在，所以它应该插入一个新表，但是表之间有 SINGLE 换行符，这会插入到另一个表中而不是中间表。

' Now move up two lines, beyond the table end
                Selection.MoveUp Unit:=wdLine, Count:=2

那么我怎样才能确保它始终是表之间的一致换行符？有没有办法删除表之间的所有换行符，然后重新创建它们，然后插入表？或者我可以以某种方式遍历文档中的所有表格吗？或者有没有其他方法可以确保不会发生这样的错误？

这是我的主要代码：

'here we alter the docout tables
If Not searchAll(dokType) Then
    Call addList(dokType, Settings.documentTypeFile)
    docNumber = "01"
Else

下面是我判断 PL 是否存在的代码，在这种情况下将返回 false：

' Moves cursor to the place the given string is found, or replace it
  Function searchAll(searchText As String, Optional replaceText As String = "GGG") As Boolean
    'default false
    searchAll = False


    If Not replaceText = "GGG" Then

        With ActiveDocument.Range.Find
             .Text = searchText
             .forward = True
             .Wrap = wdFindContinue
             .Format = True
             .MatchCase = True
             .MatchWholeWord = True
            .Replacement.Text = replaceText
            If .Execute(Replace:=wdReplaceAll) Then
                searchAll = True
            End If
        End With
    'just searching
    Else
         With Selection.Find
             .Text = searchText
             .forward = True
             .Wrap = wdFindContinue
             .Format = True
             .MatchCase = True
             .MatchWholeWord = True
             If .Execute Then
                searchAll = True
            End If
        End With
    End If


End Function

这里的代码实际上计算了表格的放置位置并添加它，这就是问题所在（重写为循环遍历表格或修改 moveup 函数）

 Sub addList(tableKey As String, filenameTypes As String)
    Dim dict As Object
    Dim addAtEnd As Boolean
    Dim keyArray As Variant
    Dim startSearching As Boolean
    Dim element As Variant
    'Dictionary with all types
    Set dict = getTypes(filenameTypes)

   With dict
   addAtEnd = False
    'extract keys into variant array
    keyArray = .keys
    startSearching = False
    For Each element In keyArray
          'looping untill we find the element we want to add
          If element = tableKey Then
            startSearching = True
           End If


        'Finding the next table after were we want to insert
        If startSearching Then
              If searchAll(CStr(element)) Then
                  addAtEnd = False
                  Exit For
              Else
                  addAtEnd = True
              End If
        End If

    Next

    If addAtEnd Then
        Selection.EndKey Unit:=wdStory
    Else
        Call HelpFunctions.moveCursorUp(CStr(element))
    End If

    Call addTable("UT", tableKey, .item(tableKey), Settings.docUtPath)

    End With

    Set dict = Nothing


 End Sub

最后是上移函数，它显然会向上移动到下一个表中。

'move cursor up
  Function moveCursorUp(searchText As String)

    If Not searchAll(searchText) Then
        MsgBox "Failed to move cursor"
    Else
         'Selection.Tables(1).Select

        If Selection.Information(wdWithInTable) Then
            Selection.Tables(1).Range.Select
            Selection.Collapse 1

            ' Now move up two lines, beyond the table end
            Selection.MoveUp Unit:=wdLine, Count:=2
        End If
        'Selection.Collapse WdCollapseDirection.wdCollapseStart
    End If

  End Function

这里是 addtable 代码，它基本上有一个空表存储在一个单独的文件中。

  Function addTable(typeOfTable As String, category As String, description As String, templateFolder As String)
        'Insert out table
        If UCase(typeOfTable) = "UT" Then
            Selection.InsertFile FileName:=templateFolder + "\Doklistut.doc", Range:="", _
            ConfirmConversions:=False, link:=False, Attachment:=False
        'insert inn table
        ElseIf UCase(typeOfTable) = "INN" Then
            Selection.InsertFile FileName:=templateFolder + "\Doklistinn.doc", Range:="", _
            ConfirmConversions:=False, link:=False, Attachment:=False
        Else
            MsgBox "wrong argument given: either inn or ut is allowed"
            Exit Function
        End If

        'Replace the DT with the category
         If Not searchAll("DT", category) Then
             MsgBox "Failed to replace category in table"
         End If

          'Replace the Dokumenttype with the category
         If Not searchAll("Dokumenttype", description) Then
             MsgBox "Failed to replace document type in table"
         End If
  End Function

【问题讨论】：

嗯，您向我们展示了与操作表格无关的代码，而不是与表格一起使用的代码。例如，缺少您的代码“调用”的 AddTable。不知道“tableKey”是什么......您想要做的一个真正的大问题是您使用选择而不是对象，例如范围和表格。我可以告诉你的一件事是你必须在表格之间至少有一个段落标记，否则 Word 会将两个表格合并为一个表格 - 你不希望这样。
为了保持一致，我会确保表格之间只有一个段落。如果您在视觉上想要更多空间，请使用 SpaceBefore 或 SpaceAfter 格式化段落（使用 STYLES！）。而且，是的，可以遍历文档中的表格，但是由于您没有向我们展示任何与表格一起使用的代码，所以只能这么说。
FWIW (a) 我同意 Cindy Meister 的 cmets 但 (b) IMO 的真正问题是您对用户所做的事情有多少控制权。如果您有很多控制权，并且您的用户都在使用最新版本的 Windows Word，那么确保您在表格之间有一种特定的、可识别的间隙的一种方法可能是插入一个非-deletable 控制它们之间的内容。用户可能会不小心在表之间添加额外的空间，但删除控件会更加困难。等等……
很抱歉我忘记了 addtable 代码，我现在编辑原来的帖子。我正在按照建议重写以使用对象。很快就会公布我的进展:)
运行当前代码的问题在哪里？

标签： vba ms-word

【解决方案1】：

感谢所有的输入，我现在已经完全修改了代码，它现在可以按预期工作，它可能可以改进，尤其是选择方法。

Sub addList(tableKey As String, tableDescription As String)
    Selection.EndKey Unit:=wdStory
    Call addTable(tableKey, tableDescription)
    Call SortTables
 End Sub

Sub Deleemptylines()
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
    .Text = "^p"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Sub SortTables()
    Dim i As Long
    Dim iMin As Long
    Dim iMax As Long
    Dim blnSwapped As Boolean

    Call Deleemptylines
    iMin = 1
    iMax = ActiveDocument.Tables.Count - 1

    Do
        blnSwapped = False
        For i = iMin To iMax

          If ActiveDocument.Tables(i).Cell(1, 1).Range.Text > ActiveDocument.Tables(i + 1).Cell(1, 1).Range.Text Then

                ActiveDocument.Tables(i).Range.Cut

                ActiveDocument.Tables(i).Select
                Selection.Collapse WdCollapseDirection.wdCollapseEnd
                Selection.Paragraphs.Add
                Selection.Paragraphs.Add
                Selection.MoveDown Unit:=wdLine, Count:=1
                Selection.MoveUp Unit:=wdLine, Count:=1
                Selection.Paste
                blnSwapped = True
            End If
        Next i
        iMax = iMax - 1
    Loop Until Not blnSwapped

    Call Deleemptylines
End Sub


  Function addTable(category As String, description As String)
        'Insert out table
        Selection.InsertFile FileName:=Settings.docUtPath + "\Doklistut.doc", Range:="", _
        ConfirmConversions:=False, link:=False, Attachment:=False

        'Replace the DT with the category
         If Not searchAll("DT", category) Then
             MsgBox "Failed to replace category in table"
         End If

        'Replace the Dokumenttype with the category
         If Not searchAll("Dokumenttype", description) Then
             MsgBox "Failed to replace document type in table"
         End If
  End Function

【讨论】：