#1
|
|||
|
|||
VBA to find and replace but ask to continue
I currently use this code to Subscript certain areas of my document, but it has been updating areas I don't need subscipted. How can I have the macro ask me if that paragraph should have the numbers subscripted?
Code:
Sub SubscriptPara() Selection.HomeKey Unit:=wdStory, Extend:=wdMove With Selection.Find .ClearFormatting .Replacement.ClearFormatting With .Replacement.Font .Bold = True .Color = vbBlack .Superscript = True .Size = 10 End With .Text = "[0-9]{1,} " .Replacement.Text = "^&" .Execute Replace:=wdReplaceAll .Forward = True .Wrap = wdFindContinue .Format = True .MatchWildcards = True End With End Sub |
#2
|
||||
|
||||
This'll prompt for, and act on, each occurrence. If you actually do want your response to apply to all occurrences in the paragraph (seems unlikely but that's how I read your question), that'll need some more work.
Code:
Sub SubscriptPara() Selection.HomeKey wdStory With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = "[0-9]{1,} " .Forward = True .Wrap = wdFindContinue .Format = True .MatchWildcards = True Do While .Execute If MsgBox("Subscript here?", vbYesNo) = vbYes Then With Selection.Range.Font .Bold = True .Color = vbBlack .Superscript = True .Size = 10 End With End If Loop End With End Sub |
#3
|
|||
|
|||
Try:
Code:
Sub SubscriptPara() Selection.HomeKey Unit:=wdStory, Extend:=wdMove Dim a As String With Selection.find .ClearFormatting .Replacement.ClearFormatting With .Replacement.font .Bold = True .Color = vbBlack .Superscript = True .Size = 10 End With .Text = "[0-9]{1,} " .Replacement.Text = "^&" .Forward = True .Wrap = wdFindContinue .format = True .MatchWildcards = True Do While .Execute = True a = MsgBox("Do you want the selection to be subscriptted?", vbYesNoCancel) If a = vbYes Then .Execute Replace:=wdReplaceOne ElseIf a = vbNo Then .Execute Else Exit Sub End If Loop End With End Sub |
#4
|
|||
|
|||
Not very elegant, but seems to work:
Code:
Sub FindNum() Dim oRng As Range Set oRng = ActiveDocument.Range With oRng.Find .ClearFormatting .Font.Superscript = False 'Don't find if already superscripted .Text = "[0-9]{1,} " .Forward = True .Wrap = wdFindStop .Format = True .MatchWildcards = True Do While .Execute oRng.Select Select Case MsgBox("Do you want the numbers found in the current paragraph to be subscripted?", vbYesNoCancel) Case vbYes SubscriptPara oRng.Paragraphs(1).Range Case vbNo oRng.End = oRng.Paragraphs(1).Range.End Case Else: Exit Sub End Select oRng.Collapse wdCollapseEnd Loop End With lbl_Exit: Exit Sub End Sub Sub SubscriptPara(oRng As Range) Dim oRngPar As Range Set oRngPar = oRng.Duplicate With oRng.Find .ClearFormatting .Font.Superscript = False 'Don't find if already superscripted .Text = "[0-9]{1,} " .MatchWildcards = True Do While .Execute If oRng.InRange(oRngPar) Then With oRng.Font .Bold = True .Color = vbBlack .Superscript = True .Size = 10 End With Else Exit Do End If oRng.Collapse wdCollapseEnd Loop End With lbl_Exit: Exit Sub End Sub Last edited by gmaxey; 06-29-2022 at 12:20 PM. Reason: Correct code to OP specs |
#5
|
|||
|
|||
Thank you to all for the responses.
Quote:
Here is an example: Quote:
And BTW, Greg I'm keen to your code since it's using the range object. Also Greg, thank you for your service. I myself have done some USAF time. |
#6
|
|||
|
|||
Jeffrey, see my edited post
|
#7
|
|||
|
|||
Wow. That is absolutely perfect Greg. Thank you very much.
In your code, I see you use the lbl_Exit: a lot. Can you explain why you used that? |
#8
|
||||
|
||||
Jeffrey, just FYI: I noticed that although your post is about subscripts, your original code creates superscripts.
|
#9
|
|||
|
|||
Yes, thanks mark99k, I see that now. I surely want to do superscripts.
|
#10
|
|||
|
|||
Jeffery,
A personal style thing. Not always needed. Code:
Sub Demo() Dim oRng As Range Set oRng = ActiveDocument.Range On Error GoTo Err_Handler Err.Raise 6 MsgBox "You won't see this message" lbl_Exit: Set oRng = Nothing Exit Sub Err_Handler: MsgBox "An error has occurred" Resume lbl_Exit End Sub |
#11
|
|||
|
|||
Got it, thanks again Greg.
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
How do you use the find and replace tool to find dates and times in Excel 2013? | Jules90 | Excel | 3 | 04-14-2020 07:40 PM |
In Find and Replace, can Word stop after each Replace? | wardw | Word | 1 | 06-08-2017 02:47 PM |
Find what box in Find and replace limits the length of a search term | Hoxton118 | Word VBA | 7 | 06-10-2014 05:05 AM |
Bad view when using Find and Find & Replace - Word places found string on top line | paulkaye | Word | 4 | 12-06-2011 11:05 PM |
Help with find and replace or query and replace | shabbaranks | Excel | 4 | 03-19-2011 08:38 AM |