我已经编写了宏来格式化团队成绩单。我需要将语句中的 Q) 以及 Q) 后面的语句加粗。 A) 需要加粗，但 A) 后面的语句则不需要。在我创建的代码中，只有 Q) 和 A) 是粗体的，后面的语句不是粗体的。谁能看出宏有什么问题吗？
Public Sub MsNewTeamsVersion()
On Error Resume Next
Dim doc As Document
Set doc = ActiveDocument
' Regular expressions for matching timestamps and speaker names
Dim regexTimestamp As RegExp
Dim regexName As RegExp
Dim match As Object
Dim matches As Object
Dim lines() As String
Dim isOIGSpeaker As Boolean
Dim hasTimestamp As Boolean
Dim sentence As Object
Dim i As Integer
Set regexTimestamp = New RegExp
Set regexName = New RegExp
' Pattern to match timestamps in the format [HH:MM]
'regexTimestamp.pattern = "?([0-9]{1})?:([0-9]{1,2}:[0-9]{2})"
regexTimestamp.pattern = "(?:(\d{1,2}):)?(\d{1,2}):(\d{2})"
regexTimestamp.Global = True
' Pattern to match speaker names ending with (OIG)
regexName.pattern = "(\w+\W\s\w+\s\(OIG\))"
regexName.Global = True
' Remove shapes
Call RemoveShapes
' Remove carriage returns
doc.Content.text = Replace(doc.Content.text, Chr(11), " ")
doc.Content.Bold = False
' Look for timestamps
Set matches = regexTimestamp.Execute(doc.Content.text)
' Loop through timestamps and now insert a new line
' The previous code collapses everything to one paragraph and
' this makes sure the headers have a space after it.
For Each match In matches
doc.Content.text = Replace(doc.Content.text, match.Value, match.Value & vbNewLine)
Next match
'Loop through each paragraph
For Each para In doc.paragraphs
'Split lines in paragraph
lines() = Split(para.Range.text, Chr(11)) ' Split paragraph into lines
'Initialize loopers
i = 0
'Initialize booleans
isOIGSpeaker = False
hasTimestamp = False
'Loop through lines in paragraph
For Each Line In lines
Set sentence = para.Range.paragraphs(1).Range.Duplicate ' Set "sentence" to the current line
sentence.Start = para.Range.Start + InStr(para.Range.text, Line) - 1
sentence.End = sentence.Start + Len(Line)
'Check is speaker is OIG in line
isOIGSpeaker = CheckOIGSpeaker(sentence.text)
'Check if timestamp in line
hasTimestamp = CheckTimeStamp(sentence.text)
'Based on if OIG and if has timestamp, process accordingly
If isOIGSpeaker = True And hasTimestamp = True Then
sentence.Font.Bold = True
sentence.InsertAfter vbNewLine & "Q) "
ElseIf isOIGSpeaker = False And hasTimestamp = True Then
sentence.Font.Bold = True
sentence.InsertAfter vbNewLine & "A) "
Else
sentence.Font.Bold = False
End If
'Increment looper
i = i + 1
Next Line
Next para
Call BoldAll("Q)")
Call BoldAll("A)")
Call ReplaceDoubleParagraphs
'Call ReplaceTimeWithDurations
'Cleanup
Set sentence = Nothing
Set match = Nothing
Set matches = Nothing
Set regexTimestamp = Nothing
Set regexName = Nothing
End Sub
Private Sub BoldAll(text As String)
With ActiveDocument.Content.Find
.ClearFormatting
' Substitute the text you want to make bold
.text = text
.Replacement.ClearFormatting
.Replacement.Font.Bold = True
.Replacement.text = "^&"
.Format = True
.Forward = True
.Wrap = wdFindStop
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
End Sub
Private Function CheckOIGSpeaker(text As String) As Boolean
'This function checks if there is an OIG Speaker
Dim regexName As RegExp
Set regexName = New RegExp
With regexName
.pattern = "(\w+\W\s\w+\s\(OIG\))"
.Global = True
.IgnoreCase = True
If .test(text) Then
CheckOIGSpeaker = True
Else
CheckOIGSpeaker = False
End If
End With
End Function
Private Function CheckTimeStamp(text As String) As Boolean
'This function checks if there is a timestamp in the text
Dim regexTimestamp As RegExp
Set regexTimestamp = New RegExp
With regexTimestamp
'.pattern = "?([0-9]{1})?:([0-9]{1,2}:[0-9]{2})"
.pattern = "(?:(\d{1,2}):)?(\d{1,2}):(\d{2})"
.Global = True
.IgnoreCase = True
If .test(text) Then
CheckTimeStamp = True
Else
CheckTimeStamp = False
End If
End With
End Function
Private Sub RemoveShapes()
'This method removes all shapes
For i = ActiveDocument.Shapes.Count To 1 Step -1
ActiveDocument.Shapes(i).Delete
Next i
End Sub
Private Function FindRegexMatches(text As String, pattern As String) As Object
Dim rx As RegExp
Set rx = New RegExp
With rx
.pattern = pattern
.Global = True
.IgnoreCase = True
Set FindRegexMatches = rx.Execute(text)
End With
End Function
Private Sub ReplaceTimeWithDurations()
Dim doc As Document
Dim match As Object
Dim matches As Object
Dim prevMatchVal As Date
Dim prevMatchText As String
Dim strDuration As String
Set doc = ActiveDocument
prevMatchText = Format("00:00:00", "HH:MM:SS")
prevMatchValue = TimeValue(prevMatchText)
Set matches = FindRegexMatches(doc.Content.text, "([0-9]{1,2}:[0-9]{2})")
For Each match In matches
strDuration = prevMatchText & " - " & Format(TimeValue(Format(match.Value, "HH:MM:SS")) + prevMatchValue, "HH:MM:SS")
prevMatchValue = TimeValue(Format(match.Value, "HH:MM:SS")) + prevMatchValue
prevMatchText = Format(prevMatchValue, "HH:MM:SS")
'doc.Content.text = Replace(doc.Content.text, match.Value, strDuration, 1, 1, vbBinaryCompare)
With doc.Content.Find
.text = match.Value
.Replacement.text = strDuration
.Format = True
.Execute Replace:=wdReplaceOne
End With
Next match
End Sub
Private Sub ReplaceDoubleParagraphs()
' Find and replace double paragraph marks with single paragraph marks
With Selection.Find
.text = "^p^p"
.Replacement.text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
' Execute the replacement
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
On Error Resume Next
Dim doc As Document
Set doc = ActiveDocument
' Regular expressions for matching timestamps and speaker names
Dim regexTimestamp As RegExp
Dim regexName As RegExp
Dim match As Object
Dim matches As Object
Dim lines() As String
Dim isOIGSpeaker As Boolean
Dim hasTimestamp As Boolean
Dim sentence As Object
Dim i As Integer
Set regexTimestamp = New RegExp
Set regexName = New RegExp
' Pattern to match timestamps in the format [HH:MM]
'regexTimestamp.pattern = "?([0-9]{1})?:([0-9]{1,2}:[0-9]{2})"
regexTimestamp.pattern = "(?:(\d{1,2}):)?(\d{1,2}):(\d{2})"
regexTimestamp.Global = True
' Pattern to match speaker names ending with (OIG)
regexName.pattern = "(\w+\W\s\w+\s\(OIG\))"
regexName.Global = True
' Remove shapes
Call RemoveShapes
' Remove carriage returns
doc.Content.text = Replace(doc.Content.text, Chr(11), " ")
doc.Content.Bold = False
' Look for timestamps
Set matches = regexTimestamp.Execute(doc.Content.text)
' Loop through timestamps and now insert a new line
' The previous code collapses everything to one paragraph and
' this makes sure the headers have a space after it.
For Each match In matches
doc.Content.text = Replace(doc.Content.text, match.Value, match.Value & vbNewLine)
Next match
'Loop through each paragraph
For Each para In doc.paragraphs
'Split lines in paragraph
lines() = Split(para.Range.text, Chr(11)) ' Split paragraph into lines
'Initialize loopers
i = 0
'Initialize booleans
isOIGSpeaker = False
hasTimestamp = False
'Loop through lines in paragraph
For Each Line In lines
Set sentence = para.Range.paragraphs(1).Range.Duplicate ' Set "sentence" to the current line
sentence.Start = para.Range.Start + InStr(para.Range.text, Line) - 1
sentence.End = sentence.Start + Len(Line)
'Check is speaker is OIG in line
isOIGSpeaker = CheckOIGSpeaker(sentence.text)
'Check if timestamp in line
hasTimestamp = CheckTimeStamp(sentence.text)
'Based on if OIG and if has timestamp, process accordingly
If isOIGSpeaker = True And hasTimestamp = True Then
sentence.Font.Bold = True
sentence.InsertAfter vbNewLine & "Q) "
ElseIf isOIGSpeaker = False And hasTimestamp = True Then
sentence.Font.Bold = True
sentence.InsertAfter vbNewLine & "A) "
Else
sentence.Font.Bold = False
End If
'Increment looper
i = i + 1
Next Line
Next para
Call BoldAll("Q)")
Call BoldAll("A)")
Call ReplaceDoubleParagraphs
'Call ReplaceTimeWithDurations
'Cleanup
Set sentence = Nothing
Set match = Nothing
Set matches = Nothing
Set regexTimestamp = Nothing
Set regexName = Nothing
End Sub
Private Sub BoldAll(text As String)
With ActiveDocument.Content.Find
.ClearFormatting
' Substitute the text you want to make bold
.text = text
.Replacement.ClearFormatting
.Replacement.Font.Bold = True
.Replacement.text = "^&"
.Format = True
.Forward = True
.Wrap = wdFindStop
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
End Sub
Private Function CheckOIGSpeaker(text As String) As Boolean
'This function checks if there is an OIG Speaker
Dim regexName As RegExp
Set regexName = New RegExp
With regexName
.pattern = "(\w+\W\s\w+\s\(OIG\))"
.Global = True
.IgnoreCase = True
If .test(text) Then
CheckOIGSpeaker = True
Else
CheckOIGSpeaker = False
End If
End With
End Function
Private Function CheckTimeStamp(text As String) As Boolean
'This function checks if there is a timestamp in the text
Dim regexTimestamp As RegExp
Set regexTimestamp = New RegExp
With regexTimestamp
'.pattern = "?([0-9]{1})?:([0-9]{1,2}:[0-9]{2})"
.pattern = "(?:(\d{1,2}):)?(\d{1,2}):(\d{2})"
.Global = True
.IgnoreCase = True
If .test(text) Then
CheckTimeStamp = True
Else
CheckTimeStamp = False
End If
End With
End Function
Private Sub RemoveShapes()
'This method removes all shapes
For i = ActiveDocument.Shapes.Count To 1 Step -1
ActiveDocument.Shapes(i).Delete
Next i
End Sub
Private Function FindRegexMatches(text As String, pattern As String) As Object
Dim rx As RegExp
Set rx = New RegExp
With rx
.pattern = pattern
.Global = True
.IgnoreCase = True
Set FindRegexMatches = rx.Execute(text)
End With
End Function
Private Sub ReplaceTimeWithDurations()
Dim doc As Document
Dim match As Object
Dim matches As Object
Dim prevMatchVal As Date
Dim prevMatchText As String
Dim strDuration As String
Set doc = ActiveDocument
prevMatchText = Format("00:00:00", "HH:MM:SS")
prevMatchValue = TimeValue(prevMatchText)
Set matches = FindRegexMatches(doc.Content.text, "([0-9]{1,2}:[0-9]{2})")
For Each match In matches
strDuration = prevMatchText & " - " & Format(TimeValue(Format(match.Value, "HH:MM:SS")) + prevMatchValue, "HH:MM:SS")
prevMatchValue = TimeValue(Format(match.Value, "HH:MM:SS")) + prevMatchValue
prevMatchText = Format(prevMatchValue, "HH:MM:SS")
'doc.Content.text = Replace(doc.Content.text, match.Value, strDuration, 1, 1, vbBinaryCompare)
With doc.Content.Find
.text = match.Value
.Replacement.text = strDuration
.Format = True
.Execute Replace:=wdReplaceOne
End With
Next match
End Sub
Private Sub ReplaceDoubleParagraphs()
' Find and replace double paragraph marks with single paragraph marks
With Selection.Find
.text = "^p^p"
.Replacement.text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
' Execute the replacement
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
预计 Q) 之后的陈述是粗体的。
您需要的只是：
Sub TeamsFmt()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Font.Bold = True
.Execute Text:="Q\)*A\)", MatchWildcards:=True, Replace:=wdReplaceAll, _
Forward:=True, Wrap:=wdFindContinue, Format:=True, ReplaceWith:="^&"
End With
Application.ScreenUpdating = True
End Sub