You can refer to my this answer.
https://stackoverflow.com/a/76260672/8249058
In that answer, I did not use the copy command, but You can use the Range object I already found when I want to highlight it, apply it's Copy method (if you are sure you want to select it and highlight it, then apply the Select method, otherwise, just to copy it is not necessary.) In this line:
d.Range(match.FirstIndex + 2, match.FirstIndex + match.Length + 2).Font.ColorIndex = wdRed
That will be like :
dim rng as Range
set rng=d.Range(match.FirstIndex + 2, match.FirstIndex + match.Length + 2)
'rng.Font.ColorIndex = wdRed
rem this will just highlight the range found by reExp
rng.HighlightColorIndex = wdGray25
rem this will highlight the sentence where range found by reExp
rng.Sentences(1).HighlightColorIndex = wdGray25
rng.Copy
rem default omit
'rng.Select 'Use only when necessary
If not necessary, try to use Range, not Selection or Selection.Range. see my article here.
If you have any questions, please feel free to discuss them. Thank you
The Code while you want to mark them one by one:
Sub SelectHighlightandCopy()
Dim regEx As Object, match As Object, matchs As Object
'Dim regEx As New VBScript_RegExp_55.RegExp, match As VBScript_RegExp_55.match, matchs As VBScript_RegExp_55.MatchCollection
Dim ur As UndoRecord, d As Document, s As Long, rng As Range
Set ur = Word.Application.UndoRecord
ur.StartCustomRecord "SelectHighlightandCopy"
Set d = ActiveDocument: Set rng = d.Content
If Selection.Characters.Count > 2 Then Selection.Collapse
s = Selection.Start
Dim sentence As Range
Set regEx = CreateObject("VBScript.RegExp")
With regEx
.Global = False 'True
.IgnoreCase = False
End With
Set sentence = Selection.Sentences(1)
regEx.Pattern = ";"
If regEx.test(sentence.Text) Then
GoSub SelectMarkCopy
Else
regEx.Pattern = ":"
If regEx.test(sentence.Text) Then
GoSub SelectMarkCopy
Else
'regEx.Pattern = "\.(?![\d+.\d+])|\r|\n}"
rng.SetRange s, sentence.End
rng.Select
rng.HighlightColorIndex = wdGray25
rng.Copy
End If
End If
ur.EndCustomRecord
' Selection.Collapse
Exit Sub
SelectMarkCopy:
Set matchs = regEx.Execute(sentence)
Set match = matchs(0)
rng.SetRange s, sentence.Start + match.FirstIndex + 1
rng.Select
rng.HighlightColorIndex = wdTurquoise
rng.Copy
Return
End Sub
The Code while you want to mark them all in once:
suppose in this scenario:
If this is the result you want to, and all the text is executed by the code.
Sub SelectHighlightandCopy() 'The Code while you want to mark them all in once
Dim regEx As Object, match As Object, matchs As Object
'Dim regEx As New VBScript_RegExp_55.RegExp, match As VBScript_RegExp_55.match, matchs As VBScript_RegExp_55.MatchCollection
Dim ur As UndoRecord, d As Document, s As Long, rng As Range
Set ur = Word.Application.UndoRecord
ur.StartCustomRecord "SelectHighlightandCopy"
Set d = ActiveDocument: Set rng = d.Content
Dim sentence As Range
Set regEx = CreateObject("VBScript.RegExp")
With regEx
.Global = False 'True
.IgnoreCase = False
End With
For Each sentence In d.Sentences
s = sentence.Start
regEx.Pattern = ";"
If regEx.test(sentence.Text) Then
GoSub SelectMarkCopy
Else
regEx.Pattern = ":"
If regEx.test(sentence.Text) Then
GoSub SelectMarkCopy
Else
'regEx.Pattern = "\.(?![\d+.\d+])|\r|\n}"
rng.SetRange s, sentence.End
' rng.Select
rng.HighlightColorIndex = wdGray25
rng.Copy
End If
End If
Next sentence
ur.EndCustomRecord
Exit Sub
SelectMarkCopy:
Set matchs = regEx.Execute(sentence)
Set match = matchs(0)
rng.SetRange s, sentence.Start + match.FirstIndex + 1
' rng.Select
rng.HighlightColorIndex = wdTurquoise
rng.Copy
Return
End Sub
The result of program execution
The Code while you want to mark them all in once from the cursor position(insertion position) beginning
Sub SelectHighlightandCopy() 'The Code while you want to mark them all in once from the cursor position(insertion position) beginning
Dim regEx As Object, match As Object, matchs As Object
'Dim regEx As New VBScript_RegExp_55.RegExp, match As VBScript_RegExp_55.match, matchs As VBScript_RegExp_55.MatchCollection
Dim ur As UndoRecord, d As Document, s As Long, rng As Range
Set ur = Word.Application.UndoRecord
ur.StartCustomRecord "SelectHighlightandCopy"
Set d = ActiveDocument: Set rng = d.Content
s = Selection.Start
Dim sentence As Range
Set regEx = CreateObject("VBScript.RegExp")
With regEx
.Global = False 'True
.IgnoreCase = False
End With
For Each sentence In d.Range(s, d.Content.End).Sentences
regEx.Pattern = ";"
If regEx.test(sentence.Text) Then
GoSub SelectMarkCopy
Else
regEx.Pattern = ":"
If regEx.test(sentence.Text) Then
GoSub SelectMarkCopy
Else
'regEx.Pattern = "\.(?![\d+.\d+])|\r|\n}"
rng.SetRange s, sentence.End
' rng.Select
rng.HighlightColorIndex = wdGray25
rng.Copy
End If
End If
If Not sentence.Next Is Nothing Then
s = sentence.Next.Start
End If
Next sentence
ur.EndCustomRecord
Exit Sub
SelectMarkCopy:
Set matchs = regEx.Execute(sentence)
Set match = matchs(0)
If sentence.Start + match.FirstIndex < s Then
s = sentence.Start
End If
rng.SetRange s, sentence.Start + match.FirstIndex + 1
' rng.Select
rng.HighlightColorIndex = wdTurquoise
rng.Copy
Return
End Sub
The result of program execution
Sentence by Sentence comparison, except sentences containing fields(functional variables)
Sub SelectHighlightandCopy() 'Sentence by Sentence comparison, except sentences containing fields(functional variables)
Dim regEx As Object, match As Object, matchs As Object
'Dim regEx As New VBScript_RegExp_55.RegExp, match As VBScript_RegExp_55.match, matchs As VBScript_RegExp_55.MatchCollection
Dim ur As UndoRecord, d As Document, s As Long, rng As Range, s1 As Long ', txt As String, hasFields As Boolean
Set ur = Word.Application.UndoRecord
ur.StartCustomRecord "SelectHighlightandCopy"
Set d = ActiveDocument: Set rng = d.Content
' If Selection.Characters.Count > 2 Then Selection.Collapse
Dim sentence As Range
Set regEx = CreateObject("VBScript.RegExp")
With regEx
.Global = False 'True
.IgnoreCase = False
End With
KeepGoing:
Set sentence = Selection.Sentences(1)
If sentence.Fields.Count = 0 Then
' txt = sentence.Text
Else
' hasFields = True
' txt = sentence.Fields(1).Code
MsgBox "There are fields, please check by yourself!", vbExclamation
Exit Sub
End If
If s1 = 0 Then
s = sentence.Start
Else
s = s1
sentence.SetRange s1, sentence.End
End If
regEx.Pattern = ";"
If regEx.test(sentence.Text) Then
'If regEx.test(txt) Then
GoSub SelectMarkCopy
GoTo KeepGoing
Else
regEx.Pattern = ":"
If regEx.test(sentence.Text) Then
'If regEx.test(txt) Then
GoSub SelectMarkCopy
GoTo KeepGoing
Else
'regEx.Pattern = "\.(?![\d+.\d+])|\r|\n}"
rng.SetRange s, sentence.End
rng.HighlightColorIndex = wdGray25
rng.Copy
rng.Select
s1 = 0
End If
End If
ur.EndCustomRecord
Selection.Document.ActiveWindow.ScrollIntoView Selection.Range
Selection.Collapse wdCollapseEnd
' If hasFields Then
' Selection.Range.SetRange Selection.Sentences(1).Next.Start, Selection.Sentences(1).Next.Start
' End If
Exit Sub
SelectMarkCopy:
Set matchs = regEx.Execute(sentence)
'Set matchs = regEx.Execute(txt)
Set match = matchs(0)
rng.SetRange s, sentence.Start + match.FirstIndex + 1
rng.HighlightColorIndex = wdTurquoise
rng.Copy
rng.Select
s1 = rng.End
Selection.Collapse wdCollapseEnd
' If hasFields Then
' Selection.MoveRight
' 'Selection.Range.SetRange Selection.Sentences(1).Next.Start, Selection.Sentences(1).Next.Start
' End If
Return
End Sub
