Question

如何批量修改Word文档中的表格样式和题注格式

Answer 1

在进行大型项目的方案文档设计时，一个文档中有可能涉及到上百个图表，在最后定稿的时候，需要进行统一的格式化处理。面对这些数目庞大的表格，挨个用格式刷进行处理，一路刷下来往往手都会刷酸，更令人奔溃的是好不容易刷完了，发现字体或大小不对，这时候可能需要再重新刷一遍。那么如果能提高效率呢？
word中的VBA功能，就是专为这种工作量庞大，而需要重复的工作设计的。对表格的样式进行统一处理VBA代码如下：
Sub FormatAllTables()For i = 1 To ActiveDocument.Tables.Count ' ActiveDocument.Tables(i).Style = "my"
With ActiveDocument.Tables(i).Range.ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpace1pt5
.Alignment = wdAlignParagraphJustify
.WidowControl = False
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.MirrorIndents = False
.TextboxTightWrap = wdTightNone
.AutoAdjustRightIndent = True
.DisableLineHeightGrid = False
.FarEastLineBreakControl = True
.WordWrap = True
.HangingPunctuation = True
.HalfWidthPunctuationOnTopOfLine = False
.AddSpaceBetweenFarEastAndAlpha = True
.AddSpaceBetweenFarEastAndDigit = True
.BaseLineAlignment = wdBaselineAlignAuto End With

' 设置表中的字体及大小
ActiveDocument.Tables(i).Select
With Selection
.Font.Size = 12
.Font.Name = "宋体"
End With

ActiveDocument.Tables(i).Cell(1, 1).Select
With Selection
.SelectRow
.Font.Bold = True
.Shading.BackgroundPatternColor = -603923969
.ParagraphFormat.Alignment = wdAlignParagraphCenter End With
NextEnd Sub123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354

在文档编写中，表格中题注的字体及大小一般与正文也不一样，需要单独进行设置，由于题注设置需要自动编号，可通过VBA代码对这些自动编号的题注进行自动化处理，其基本思路是查找带有域“图”的所有文本；选中它，然后格式粘贴。其代码如下：
Sub FormatTableTitle()
myHeadings = ActiveDocument.GetCrossReferenceItems("图")
findTxt = ""
For i = 1 To UBound(myHeadings) 'MsgBox myHeadings(i)
findTxt = myHeadings(i) With Selection.Find
.Text = findTxt
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.PasteFormat Next iEnd Sub