在 Word 查找/替换宏中使用 VBA 正则表达式？

如何解决在 Word 查找/替换宏中使用 VBA 正则表达式？

我经常使用旧版文本编辑器 (Vim) 来做会议笔记，因为我可以跟上谈话的节奏。但是，大多数人（包括我自己）更喜欢 Word 中的最后注释，带有项目符号和子项目符号。这是我想转换为 Word 项目符号的文本文件示例：

Meeting notes
-------------
 * The quick brown fox
 * The quick brown fox
    - Jumped over the lazy dogs
    - Jumped over the lazy dogs
 * The quick brown fox

我录制了一个宏来将文本项目符号转换为 Word 项目符号。任何以文本项目符号“*”开头的段落都会转换为“列表项目符号 2”，然后我将“*”全局替换为“”（即删除）。以更缩进的文本项目符号“ -”开头的任何段落都会转换为“列表项目符号 4”，然后我全局删除“ -”。 “BulletsTxt2wrd”宏如下所示。

问题是，我使用Word的查找/替换功能，无法真正将上述字符串的搜索限制在段落的开头。如果段落中间有“*”（可能是“25 * 3.1415”），则会发生相同的段落格式和删除。

正则表达式可以将搜索限制在段落的开头。我在 unix 环境中使用了正则表达式，经过多年的阅读，它可以在 VBA 中完成，我在简单的 Excel 函数中使用它，以将指定的天/分钟的持续时间转换为小时。例如（参见下面的“DurtnStr2hrs”函数：

“20 小时”变为 20
“1 小时”变成 1
“1 天”变为 24
“3 天”变成 3*24
“1 分钟”变成 1/60
“70 分钟”变为 70/60

我在电子表格单元格中使用此函数，参数是包含要转换的字符串的另一个单元格。

有没有办法使用“BulletsTxt2wrd”Word宏中的正则表达式包和对象？ 好像是黑盒子，VBA代码并没有真正暴露对象包含我要操作的字符串的属性。

附言This post 不处理我记录的 Find/Replace 方法，该方法遍历整个文档以定位匹配项。

This post 指的是 VBScript，但我真的很想避免必须找出另一种语言来完成我的简单任务。

This post 也不使用我的宏中记录的查找/替换。

Sub BulletsTxt2wrd()
'
' BulletsTxt2wrd Macro
'
'
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("List Bullet 2")
    With Selection.Find
        .Text = " * "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = " * "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("List Bullet 4")
    With Selection.Find
        .Text = "    - "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "    - "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Function DurtnStr2hrs(str) As Double
   ' Use for DurtnHrs column
   Dim NewStr As String
   Dim regex1 As Object
   Set regex1 = New RegExp
   NewStr = str
   regex1.Pattern = " hours?"
   NewStr = regex1.Replace(NewStr,"")
   regex1.Pattern = " minutes?"
   NewStr = regex1.Replace(NewStr,"/60")
   regex1.Pattern = " days?"
   NewStr = regex1.Replace(NewStr,"*24")
   DurtnStr2hrs = Evaluate(NewStr)
End Function

解决方法

«问题是，我使用Word的查找/替换功能，不能真正将上述字符串的搜索限制在段落的开头»相反，您可以使用：

Sub Demo1()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^13[ *-]{1,}"
    .Replacement.Text = ""
    .Format = False
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
  End With
  Do While .Find.Execute
    .Start = .Start + 1
    Select Case Trim(.Text)
      Case "*": .Paragraphs.Last.Style = wdStyleListBullet2
      Case "-": .Paragraphs.Last.Style = wdStyleListBullet4
    End Select
    .Text = vbNullString
    .Collapse wdCollapseEnd
  Loop
End With
Application.ScreenUpdating = True
End Sub

至于 DurtnStr2hrs 转换，我注意到“20 小时”变为 20*60”的文本描述与“NewStr = regex1.Replace(NewStr,"/60")”的正则表达式之间仍然存在脱节。也就是说，尝试：

Sub Demo2()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<[0-9]@ [dh][ao][yu]*>"
    .Replacement.Text = ""
    .Format = False
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
  End With
  Do While .Find.Execute
    .Start = .Start + 1
    Select Case Split(.Text," ")(1)
      Case "hour": .Text = Split(.Text," ")(0)
      Case "hours": .Text = Split(.Text," ")(0) & "/60"
      Case "day": .Text = "24"
      Case "days": .Text = Split(.Text," ")(0) & "*24"
    End Select
    .Collapse wdCollapseEnd
  Loop
End With
Application.ScreenUpdating = True
End Sub

以下似乎可以完成这项工作：

run reg add /?