Apply braces around strikethrough string of text

[docspecial]

Hi All: Trying to find a macro for Word to apply brackets around underline text and remove underline. Also need to apply braces around string of strikethrough text.

Text like this should look [like this].
Text like this (strikethrough) should look {like this}. (keeping strikethrough)


This code works for the underlined text, but still need to address the strikethrough text.


Sub Tag_Under_Line()
Selection.ClearFormatting
Selection.HomeKey wdStory, wdMove
Selection.Find.Font.Underline = wdUnderlineSingle
Selection.Find.Execute ""
Do Until Selection.Find.Found = False
Selection.Font.Underline = wdUnderlineNone
Selection.InsertBefore "["
Selection.InsertAfter "]"
Selection.MoveRight
Selection.Find.Execute ""
Loop
End Sub


Appreciate any help!

[Aussiebear]

welcome to VBAX Docspecial. Please be patient, for one of our resident Word gurus will along shortly.

[Aussiebear]

You could try this code....



Sub Tag_Strikethroughs()
Dim aRng As Range
Set aRng = ActiveDocument.Range
With aRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.StrikeThrough = True
.Text = ""
Do While .Execute = True
aRng.InsertBefore "{"
aRng.InsertAfter "}"
aRng.Characters.Last.Font.StrikeThrough = False
aRng.Start = aRng.End
aRng.End = ActiveDocument.Range.End
Loop
End With
End Sub

[gmaxey]

Option Explicit

Sub ScratchMacro()
'A basic Word Macro coded by Gregory K. Maxey
Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Font.StrikeThrough = True
While .Execute
oRng.InsertBefore "{"
oRng.InsertAfter "}"
oRng.Collapse wdCollapseEnd
If oRng.End = ActiveDocument.Range.End Then Exit Do
Wend
End With
Set oRng = ActiveDocument.Range
With oRng.Find
.Font.Underline = wdUnderlineWords
Do While .Execute
oRng.InsertBefore "["
oRng.Collapse wdCollapseEnd
oRng.Select
oRng.Underline = wdUnderlineNone
oRng.InsertAfter "]"
If oRng.End = ActiveDocument.Range.End Then Exit Do
Loop
End With
Set oRng = ActiveDocument.Range
With oRng.Find
.Font.Underline = wdUnderlineWords
Do While .Execute
oRng.Underline = wdUnderlineNone
oRng.Collapse wdCollapseEnd
If oRng.End = ActiveDocument.Range.End Then Exit Do
Loop
End With
lbl_Exit:
Exit Sub
End Sub

[docspecial]

This works and will save us lots of time!

One addition is that the underlined text should be bolded and bracketed [ ] without underlining. I know this should be easy to add to the code, however, I can’t figure it out.

Would you please take a look?

Thank you!

[Aussiebear]

Any chance you posted this elsewhere docspecial?

[gmaxey]

Sub ScratchMacro()
'A basic Word Macro coded by Gregory K. Maxey
Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Font.StrikeThrough = True
Do While .Execute
oRng.InsertBefore "{"
oRng.InsertAfter "}"
oRng.Collapse wdCollapseEnd
If oRng.End = ActiveDocument.Range.End Then Exit Do
Loop
End With
Set oRng = ActiveDocument.Range
With oRng.Find
.Font.Underline = wdUnderlineWords
Do While .Execute
oRng.InsertBefore "["
oRng.Collapse wdCollapseEnd
oRng.InsertAfter "]"
If oRng.End = ActiveDocument.Range.End Then Exit Do
Loop
End With
Set oRng = ActiveDocument.Range
With oRng.Find
.Font.Underline = wdUnderlineWords
Do While .Execute
oRng.Underline = wdUnderlineNone
oRng.End = oRng.End - 1
oRng.Font.Bold = True
oRng.Collapse wdCollapseEnd
If oRng.End + 1 = ActiveDocument.Range.End Then Exit Do
Loop
End With
lbl_Exit:
Exit Sub
End Sub