将扫描pdf文件进行文字识别时,对带圈数字表示的注释引用和注释序号往往会将数字序号认错。例如下面的文件:
这个文件的段落十分有规律:每首诗的标题样式为标题3,标题下面的段落为诗的正文,下面有一个样式为标题4的段落,段落文本为【题解】,此段落下面有若干段落进行说明,接下来有一个样式为标题4的段落,段落文本为【校注】,此段落下面有若干个段落为注释,每条注释一段。针对这样布局的文件,可以用下面的VBA程序将注释引用和注释编号的位置全部修改正确:
Sub 更正注释引用与注释序号的编号()Dim regEx As Object, aPara As Paragraph, isBody As Boolean, isComm As BooleanDim matches, matche As Object, i%, j%Dim searchRange As Range, tmpRange As RangeSet regEx = CreateObject("VBScript.RegExp")' 之所以用正则表达式,是因为超过10的带圈数字序号在VBA编辑器中没法输入' 而Range.Find对象使用的通配符又不支持使用unicode编码With regEx.Pattern = "[\u2460-\u2473]" ' 1~20带圈数字序号.Global = True ' 查找所有匹配End Withi = 1DoSet aPara = ActiveDocument.Paragraphs(i)If aPara.Style = "标题 3" Then ' 遇到诗标题i = i + 1 ' 前进一段,进入诗正文' 设定查找区域为正文范围Set searchRange = ActiveDocument.Paragraphs(i).Range' 在正文范围内执行匹配Set matches = regEx.Execute(searchRange.Text)' 如果存在带圈数字序号,则遍历每一个带圈数字序号,替换为正确的序数If matches.Count > 0 ThenFor j = 0 To matches.Count - 1' 重置查找范围为调整后的范围Set tmpRange = searchRangeWith tmpRange.Find.Text = matches(j).Value.Wrap = 1 ' wdFindContinue.Execute ' 找到注释引用End With' 根据循环序数计算出正确的带圈数字序号并替换掉原来的文本tmpRange.Text = ChrW(j + 9312)' 为防止刚插入的正确带圈数字序号被重复匹配,将查找范围' 起始位置调整到刚插入的文本之后searchRange.SetRange tmpRange.End, searchRange.EndNext jEnd Ifi = i + 1' 如过遇到【校注】段落ElseIf aPara.Style = "标题 4" And Left(aPara.Range.Text, 4) = "【校注】" Then' 选择此段落ActiveDocument.Paragraphs(i).Range.Select' 利用Selection.Bookmarks("\headinglevel")取得此标题及所属段落作为查找区域Set searchRange = Selection.Bookmarks("\headinglevel").Range' 在该标题所属段落中进行全局查找Set matches = regEx.Execute(searchRange.Text)If matches.Count > 0 Then '以下操作与诗正文段落中的操作类似For j = 0 To matches.Count - 1Set tmpRange = searchRangeWith tmpRange.Find.Text = matches(j).Value.Wrap = 1 ' wdFindContinue.Execute ' 找到注释引用End WithtmpRange.Text = ChrW(j + 9312)searchRange.SetRange tmpRange.End, searchRange.End' 因为每条注释一个段落,所以完成一个匹配项替换应该将段落计数器加1i = i + 1Next j' 将标题段落的计数也加上i = i + 1End If' 碰上不是诗标题和注释区标题的段落,直接累加段落计数器。因为诗正文和' 注释段落已在前面处理,所以此处的段落实际上就是题注标题及其所属段落Elsei = i + 1End IfLoop While i < ActiveDocument.Paragraphs.Count '至全文最后一段终止
End Sub
以上代码通用性并不强,只能对特定结构的文档起作用,但仍然演示了正则表达式结合Range.Find进行查找并完成匹配内容定位、查找范围的调整、取得标题及其所属段落区域、数值1-20转换为带圈数字序号(更大的数值大多数字体没有对应的带圈数字序号)等技巧,因而有一定的参考价值。
根据人工智能Kimi的回答,获取标题及其所属段落的Range还有以下方法:
Sub GetTitleAndContentRange()Dim doc As DocumentDim titlePara As ParagraphDim titleRange As RangeDim contentRange As RangeSet doc = ActiveDocument' 获取第一个标题段落Set titlePara = doc.Paragraphs(1)' 获取标题段落的 RangeSet titleRange = titlePara.Range' 扩展范围以包含标题下的所有内容Set contentRange = titleRange.DuplicatecontentRange.Collapse Direction:=wdCollapseEndDo While contentRange.Paragraphs(1).Style <> titlePara.StylecontentRange.SetRange Start:=contentRange.Start, End:=contentRange.Paragraphs(1).Range.EndcontentRange.Collapse Direction:=wdCollapseEndLoop' 现在 titleRange 包含标题,contentRange 包含标题及其下的内容' 你可以对这些范围进行操作,例如复制、格式化等
End Sub
显然这个方法无论是复杂性还是执行效率都比不上选定标题段落后再使用“Selection.Bookmarks("\headinglevel").Range”获取。上文中要将标题段落本身剔除出searchRange,也只需要再添加一行代码(因为此时标题段落已经被选择):
searchRange.SetRange Selection.Range.End, searchRange.End