在 Word Find/Replace 宏中使用 VBA 正则表达式？

Question

我经常使用旧版文本编辑器 (Vim) 做会议记录，因为我可以跟上谈话的进度。但是，大多数人（包括我自己）更喜欢在 Word 中使用项目符号和 sub-bullets 作为最后的注释。这是我想转换为 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的Find/Replace功能，不能真正将上述字符串的搜索限制在段落的开头。如果段落中间有一个“*”（可能是“25 * 3.1415”），同样的段落格式化和删除也会发生

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

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

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

有没有办法在“BulletsTxt2wrd”Word宏中使用正则表达式包和objects？好像是黑盒子一样的功能，而且VBA 代码并没有真正公开包含我要操作的字符串的 object 属性。

P.S。 This post 不处理我记录的 Find/Replace 方法，该方法遍历整个文档以找到匹配项。

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

也不使用我的宏中记录的Find/Replace。

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

Answer 1

«问题是，我使用 Word 的 Find/Replace 函数，它不能真正将上述字符串的搜索限制在段落的开头» 相反，您可以使用：

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

Answer 2

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

Sub BulletTxt2doc()
doL1bullet:
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "^p * "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        Selection.Find.Execute
        If .Found = True Then
            Selection.EndKey Unit:=wdLine
            Selection.Style = ActiveDocument.Styles("List Bullet 2")
            Selection.MoveUp Unit:=wdParagraph, Count:=1
            Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend
            Selection.Delete Unit:=wdCharacter, Count:=1
            GoTo doL1bullet
        End If
    End With
doL2bullet:
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "^p    - "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        Selection.Find.Execute
        If .Found = True Then
            Selection.EndKey Unit:=wdLine
            Selection.Style = ActiveDocument.Styles("List Bullet 4")
            Selection.MoveUp Unit:=wdParagraph, Count:=1
            Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend
            Selection.Delete Unit:=wdCharacter, Count:=1
            GoTo doL2bullet
        End If
    End With
End Sub

在 Word Find/Replace 宏中使用 VBA 正则表达式？

Use VBA regular expression in Word Find/Replace macro?

vba

ms-word