Microsoft Office Forums - View Single Post

macropod · 10-11-2013, 08:11 PM

Try:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
Set Rng = ActiveDocument.Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Format = True
    .Forward = True
    .Wrap = wdFindStop
    .Text = "abc"
    .Style = "one_car"
    .Replacement.Text = ""
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    .MoveStart Unit:=wdCharacter, Count:=-3
    .InsertBefore ","
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
  .Start = Rng.Start
  With .Find
    .Text = ""
    .Execute
  End With
  Do While .Find.Found
    .InsertAfter "."
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

or, even simpler:

Code:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Format = True
    .Forward = True
    .Wrap = wdFindStop
    .Text = "abc"
    .Style = "one_car"
    .Replacement.Text = ""
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    .MoveStart Unit:=wdCharacter, Count:=-3
    .InsertBefore ","
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
  With .Find
    .Text = ""
    .Replacement.Text = "^&."
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll
  End With
End With
Application.ScreenUpdating = True
End Sub

PS: When posting code, please use the code tags. They're on the 'Go Advanced' tab.