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