使用Word 2016中的VBA代码删除空的TOC，表格和表格错误消息？

问题描述

我使用一个程序将文档导出到Word 2016，并自动更新目录，表，表以添加它找到的所有条目并分配页码。但是，在某些情况下，导出的Word文档将不包含图形，表格标题说明（可能还有标题），因此在生成TOC，图形表格和表格时，它将写入，即对于任何图形，此消息均为“找不到数字条目表。”我希望VBA要做的是找到此消息，将变量标志noToF_flag设置为True，然后删除标题“ TABLE OF附图”和域代码，以便在再次打开Word文件时不会出现错误消息重新生成。但是，在未写出此特定错误消息的情况下，保留找到的图形，标题和页面编号。表和目录也一样。就我而言，尽管我可以让VBA代码删除标题和域代码信息，但找不到能够设置标志的错误文本。我必须检测到错误消息，并保留好的图形和标题，页面。

这是我一直在玩的VBA代码，在打开文档以查找错误消息后手动运行。现在已注释掉“图形表”和域代码条目，但是一旦我可以删除错误消息，就可以设置用于删除标题和域代码的标志。 对于可以使用空的TOC，TOF和TOT条目的情况，没有运行时错误。

感谢您使用Word 2016删除此动态生成的文本的任何指针。

Public Sub FindAndDeleteEmptyTOCFields()

Dim doc As Word.Document
Dim fld As Word.Field
Dim rngFind As Word.Range

Set doc = ActiveDocument
Set rngFind = doc.Content
rngFind.TextRetrievalMode.IncludeFieldCodes = True
rngFind.TextRetrievalMode.IncludeHiddenText = True


With rngFind.Find
    .MatchWildcards = True
    ' .Text = "TABLE OF figURES"
    .Text = "No table of figures entries found."
    ' .Text = "^dTOC \h \z \c ""figure"""
    .Forward = True
    .Wrap = wdFindask   'Good for debugging since it gives a popup
    ' .Wrap = wdFindContinue
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll
    If .Execute Then
    Debug.Print rngFind.Text
    Else
    Debug.Print "not Found"
    End If
    ' End If
End With

EDIT2：

使用答案中的第一个代码清单，将完成以下程序逻辑。我可能可以使用TableId和CaptionLabels或Caption来缩小错误消息的特定来源，以便可以删除TOC，TOF，TOT的标题。

'// ============================================ =========================

' Part A (Variation 1 & 2)
' After searching the Word document for the two error messages,'  If no rewrite of captions set noATOCflg to True
  ' .Text = "No table of contents entries found."
' If rewrite of captions set noTBLfigflg to True
  ' .Text = "No table of figures entries found."
   

' Part B or,' If nofigTBLflg is True for the Error message generated as "No table of figures entries found." Then
' search for the fieldcode text and set the associated flag.
' IE. doc.CaptionLabels("figure").count >=0 then delete fieldcode and title. However,used Caption instead.
' The TOF.caption is equivalent to the \c label.
' The TOF.TableId is equivalent to a one letter code for the \f label.

  ' .Text = "^dTOC \h \z \c ""figure"""    then set noTOFflg = True
  ' .Text = "^dTOC \h \z \c ""Table"""     then set noTOTflg = True
' Delete the fieldcode for the associated flag being True.
  
'Part C
' If noATOCflg is True for the Error message generated as "No table of contents entries found." Then
' search for the field code text and set the associated flag.
' The TOC.TableId is equivalent to a one letter code for the \f label.

  ' .Text = "^dTOC \h \z \t"   ' for the main TOC header styles  then set noTOCflg = True
  ' .Text = "^dTOC \h \z \u \f fig"        then set noTOFflg = True
  ' .Text = "^dTOC \h \z \u \f TBL"        then set noTOTflg = True
 ' Delete the fieldcode for the associated flag being True.

'Part D
' If the any of the noTOCflg,noTOFflg and noTOTflg flags are True then
' search for the corresponding title and delete it,'  .Text = "TABLE OF CONTENTS"
  '  .Text = "TABLE OF figURES"
  '  .Text = "TABLE OF TABLES"

'// ============================================ =========================

编辑3：

我已经能够使用您的第一个代码清单来完成上述工作，以删除每个域代码，并为其添加删除相关标题的功能。由于我不希望文档中有空行，因此我能够删除标题末尾的段落标记。但是，在您的清单中使用“ .delete”时，试图删除删除的域代码后的段落标记时遇到了问题，这样我在文档中就不会有空行。

我正要提出一个有关在域代码字符串后面删除段落标记的问题。但是，基于第二段VBA代码在段落标记上的注释，您击败了我。我替你 我的代码，因为它非常简单。我查看了各种段落对象集合的Word对象模型，但是没有方法可以删除纯文本或域代码的段落。所以我会 看一下使用段落对象的方式。

还在搜索开关\ f的字段标签期间，VBA仅返回标签的首字母，即“ f”代表“ fig”，“ t”代表TBL，甚至不大写。因此，如果我有多个以“ F”开头的标签，我将无法确定是哪个标签，因为只会返回“ f”。具有以“ T”开头的多个标签的情况相同。对于开关\ c，即使在这种情况下它与Word使用的默认标签匹配，它也会返回我指定的确切的用户定义标签。

编辑4：

您的第二段代码清单消除了带有段落标记的标题，域代码，从而使页面上没有空白行。 当没有任何空表或它们的任何组合为空时，它可以工作。现在，可以根据使用TableOffigures也为TABLE OFEQUATIONS定义的标头样式，将其应用于附录表。当打开文档时自动运行VBA代码时，这将非常有用。

另外，关于检索域代码字符串的建议也很有用，因为不必在VBA代码中维护硬编码版本，而是可以检索它，在其中添加{和vbCr的^ d来删除域代码和段落标记解决此问题的方法是在域代码的末尾使用段落标记，该标记在删除域代码后仍然显示。这可以用作删除带有段落标记的域代码与调整第二个列表中的段落范围的另一种方式。

编辑5：

我很好奇，看看当表为空时，第二个代码清单是否适用于内置自动1和2目录的Words。错误消息“找不到目录条目。”字段代码显示为{TOC \ o“ 1-3” \ h \ z \ u}；但是，TOC标题不可编辑以更改文本，但可以通过在内置标题的顶部应用标题样式来更改标题和章节条目，标题格式样式也会更改。 第二个代码清单将删除内置的1和2 TOCS。

问题是如何通过用户命令和通过VBA将标题编辑为不同的标题和样式格式？我还可以使用此修改或vba代码来复制builin TOC的功能，以便在选择时可以获取所有表选项卡（其中两个）来更新和更改内容吗？这将使我能够创建自己的TOC，其行为类似于内置TOC。我知道Word允许人们创建自定义目录，但其中没有选项卡。

另一个问题是关于“手动”内置目录的。它们具有两个选项卡，但是已经带有默认模板条目的列表。可以手动更改列表中的每一个；但是，由于“找不到目录表项”，第二个代码清单为空时不能删除“手动”目录。消息永远不会生成，它正在寻找将其删除。此外，标题无法编辑，并且如果您在目录中选择任何行，则会显示三个垂直点图标。如果你右击该行（而不是图标），弹出显示，您可以选择“删除内容控制”，并选择当三个点图标消失。如何使用VBA创建自己的“手动”内置TOC，使其具有类似的功能并具有“内容控制”功能，使其类似于手动内置TOC？

此外，当在文档中生成引用列表时，它会生成一个无边框的表格，并从边框边缘设置文本0.01。每次更新/创建该书目表时都要不断地重新格式化，这很繁琐。由于它是内置表，因此似乎没有控制表格式的方法。在打开或编辑过程中，VBA代码可能会有助于自动控制其格式。

编辑6：

这里是使用TOCS的IF域代码链接到另一篇文章的Web链接。我不确定该如何使用，因为根据条件只能输出文本字符串。也许，这是一种将原始错误消息重写为另一条错误消息的方法，并且VBA代码可以捕获两条消息中的任何一条消息以对其进行处理。另外，我不确定IF域代码中允许的IF域代码嵌套级别的最大数量。

test for error returned by TOC field code

{IF {TOC \ h \ z \ c“ figure”} =“未找到图形表条目。” “没有表”“条目存在”}

解决方法

使用“查找”不起作用，因为您在文档中看到的文本是字段的结果。

文档同时具有TablesOfContents集合和TablesOfFigures集合。您可以遍历这些集合以查找和删除没有条目的任何对象。

Sub RemoveEmptyTOCandTOF()
   Dim index As Long
   For index = ActiveDocument.TablesOfContents.Count To 1 Step -1
      With ActiveDocument.TablesOfContents(index)
         If .Range.Text = "No table of contents entries found." Then .Delete
      End With
   Next index
   For index = ActiveDocument.TablesOfFigures.Count To 1 Step -1
      With ActiveDocument.TablesOfFigures(index)
         If .Range.Text = "No table of figures entries found." Then .Delete
      End With
   Next index
End Sub

编辑：

如果您使用Range对象，则可以进行所有必要的删除操作，而无需设置标志，计数字幕甚至无需测试您拥有哪种ToF类型。

Sub RemoveEmptyTOCandTOFExpanded()
   Dim index As Long
   Dim tblRange As Range
   For index = ActiveDocument.TablesOfContents.Count To 1 Step -1
      With ActiveDocument.TablesOfContents(index)
         If .Range.text = "No table of contents entries found." Then
            Set tblRange = .Range
            With tblRange
               'expand the range to include the paragraph mark after the field
               .Expand wdParagraph
               'move the start of the range back one paragraph so that the range includes the title
               .MoveStart wdParagraph,-1
               'delete both paragraphs
               .Delete
            End With
         End If
      End With
   Next index
   For index = ActiveDocument.TablesOfFigures.Count To 1 Step -1
      With ActiveDocument.TablesOfFigures(index)
         If .Range.text = "No table of figures entries found." Then
            Set tblRange = .Range
            With tblRange
               'expand the range to include the paragraph mark after the field
               .Expand wdParagraph
               'move the start of the range back one paragraph so that the range includes the title
               .MoveStart wdParagraph,-1
               'delete both paragraphs
               .Delete
            End With
         End If
      End With
   Next index
End Sub