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

Question

我使用一个程序将文档导出到Word 2016，并自动更新TOC、图表表和表格表，以添加它找到的任何条目并分配页码。然而，在某些情况下，导出的Word文档将不包含图形、表格标题描述(以及可能的标题)，因此当生成TOC、图形表和表格时，它将写下，即，对于没有图形的情况，该消息"；找不到图表条目表"我希望VBA能找到这条消息，将变量标志noToF_flag设置为True，然后删除标题"；"图表表"；和字段代码，以便在再次打开word文件时，不会再次生成错误消息。但如果这个特定的错误消息没有写出来，请留下它找到的数字、标题和页码。这同样适用于表格和TOC。在我的情况下，我找不到能够设置标志的错误文本，尽管我可以让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

第2版：

使用答案中的第一个代码列表，将完成以下程序逻辑。我可能可以使用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:

我已经能够使用您的第一个代码列表删除每个字段代码，并添加删除相关标题的功能。我已经能够删除标题末尾的段落标记，因为我不希望文档中有空行。然而，使用"；。删除"；在你的清单中，我在删除字段代码后的段落标记时遇到了问题，这样我就不会在文档中有空行。

我正要发布一个关于删除字段代码字符串后的段落标记的问题。然而，根据你在段落标记上的第二个VBA代码列表注释，你已经打败了我。我会代替你我的代码，因为它非常简单。我已经查看了各种段落对象集合的Word对象模型，但无论是直接文本还是字段代码，都没有删除段落的方法。所以我会看看你使用段落对象的方式。

此外，在搜索开关\f的字段标签期间，VBA只返回标签的第一个字母，即"f"表示"；图"；TBL的't'甚至没有大写。因此，如果我有多个以"；F"；我无法确定它是我的哪个标签，因为只会返回"f"。这同样适用于具有以"1"开头的多个标签；T"；。至于开关\c，它会返回我指定的用户定义的确切标签，即使在这种情况下它与Word使用的默认标签匹配。

编辑4:

你的第二个代码清单去掉了标题和带有段落标记的字段代码，这样就不会有任何空行填满页面。当没有任何空表，或者它们的任何组合都是空的时，它就起作用了。现在可以根据使用TableOfFigures为其定义的Header样式将其应用于TABLE OF APPENDIX，也可以应用于TABLE OF EQUATIONS。当VBA代码在打开文档时自动运行时，这将非常有用。

此外，您关于检索字段代码字符串的建议也很有用，因为您不必在VBA代码中维护硬编码版本，但可以检索它—为｛和vbCr到它来删除字段代码和段落标记，以解决字段代码末尾的段落标记在删除字段代码后仍然显示的问题。这可以用作删除带有段落标记的字段代码的另一种方法，而不是像第二个列表那样调整段落的范围。

编辑5:

我很好奇，当自动1和2目录为空时，第二个代码列表是否适用于内置的Words。错误消息"；找不到目录条目"并且字段代码为｛TOC\o"1-3"\h\z\u｝；但是，TOC标题不可编辑以更改文本，但标题和小节条目可以通过在内置条目之上应用标题样式来更改，标题格式样式也会更改。第二个代码列表将删除内置的1和2 TOCS。

问题是如何通过用户命令和VBA将标题编辑为不同的标题和样式格式？此外，我可以使用此修改或vba代码来复制内置TOC的功能吗？这样，当选择时，我可以获得所有表选项卡(其中两个)来更新和更改内容？这将使我能够创建自己的TOC，其行为与内置的TOC类似。我知道Word允许创建自定义的TOC，但上面没有标签。

另一个问题是关于"；手动"；内置TOC。它们有两个选项卡，但已经附带了默认模板条目的列表。可以手动更改列表中的每一个；然而，第二个代码列表不能删除"；手动"；当TOC为空时；找不到目录条目"消息永远不会被生成，它正在寻找删除它。此外，标题不能被编辑，如果您选择TOC中的任何一行，就会显示一个三垂直点图标。如果你右键点击这一行(而不是图标)，就会显示一个弹出窗口；删除内容控制"；并且当被选择时，三点图标消失。如何创建自己的"；手动"；其作用类似并且具有"；内容控制"；使用VBA来像手动内置TOC一样工作？

此外，在文档中生成引用列表时，它会生成一个没有边框的表，并将文本从边框边缘设置为0.01。每次更新/创建此参考书目表时，都要不断地重新格式化，这是非常乏味的。似乎没有办法控制表格式，因为它是内置表。VBA代码可能有助于在打开或编辑时自动控制其格式。

编辑6:

这是使用TOCS的IF字段代码的另一篇文章的网络链接。我不确定如何使用它，因为只能根据条件输出文本字符串。也许，这是一种将原始错误消息重写为另一个错误消息的方法，VBA代码可以捕获这两个消息中的任何一个来处理它。此外，我不确定IF字段代码中允许的最大IF字段代码嵌套级别。

TOC字段代码返回的错误测试

{IF{TOC\h\z\c"图"}＝"；找不到图表条目表"quot；没有表"条目存在"｝

Answer 1

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

文档同时具有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