View Single Post
 
Old 08-07-2023, 01:55 AM
East East is offline Windows 10 Office 2019
Novice
 
Join Date: Aug 2023
Posts: 7
East is on a distinguished road
Default

I think something like that should work.

Code:
Sub PromptRegExReplace()
Dim regEx As Object
Dim match As Object
Dim matches As Object
Dim rng As Range
Dim response As Integer
Dim replacementText As String

Set regEx = CreateObject("VBScript.RegExp")
regEx.pattern = "([0-9])"
regEx.Global = True

' Get the current cursor position
Dim cursorPosition As Long
cursorPosition = Selection.Start

' Set the range to start from the cursor position until the end of the document
Set matches = regEx.Execute(ActiveDocument.Range(cursorPosition, ActiveDocument.Range.End).text)
replacementText = "$1abc"

Do While matches.Count > 0
    Set match = matches(0)
    Set rng = ActiveDocument.Range(match.FirstIndex + cursorPosition, match.FirstIndex + match.Length + cursorPosition)
    rng.Select
    response = MsgBox("Replace this instance?", vbYesNoCancel)

    ' Check the value that is returned by the MsgBox function
    If response = vbYes Then
        Application.ScreenUpdating = False
        rng.text = regEx.replace(rng.text, replacementText)
        Application.ScreenUpdating = True

        ' Update the cursor position after replacing the text
        cursorPosition = rng.End

    ' No button moves without replacing
    ElseIf response = vbNo Then
        cursorPosition = rng.End

    ' Cancel button stops the macro
    ElseIf response = vbCancel Then
        Exit Sub
    End If

    ' Update the matches collection after replacing the text
    Set matches = regEx.Execute(ActiveDocument.Range(cursorPosition, ActiveDocument.Range.End).text)

Loop
End Sub
Reply With Quote