View Single Post
 
Old 05-14-2021, 06:54 AM
macropod's Avatar
macropod macropod is offline Windows 10 Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,963
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

For example:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Format = False
    .Forward = True
    .Wrap = wdFindContinue
    .MatchWildcards = True
    'Clean up UK format dates with ordinals
    .Text = "(<[0-9]{1,2})[dhnrst ]{1,3}([JFMASOND][abceghilmnoprstuvy]{2,8}>)"
    .Replacement.Text = "\1 \2"
    .Execute Replace:=wdReplaceAll
    'Clean up & reformat US format dates with/without ordinals
    .Text = "(<[JFMASOND][abceghilmnoprstuvy]{2,8})[- ]([0-9]{1,2})[dhnrst\-, ]@([12][0-9]{3}>)"
    .Replacement.Text = "\2 \1 \3"
    .Execute Replace:=wdReplaceAll
    .Text = "(<[JFMASOND][abceghilmnoprstuvy]{2,8})[- ]([0-9]{1,2})[dhnrst]@>"
    .Replacement.Text = "\2 \1"
    .Execute Replace:=wdReplaceAll
    .Text = "(<[JFMASOND][abceghilmnoprstuvy]{2,8})[- ]([0-9]{1,2}>)"
    .Execute Replace:=wdReplaceAll
    'Clean up & reformat D/M/YYYY & D-M-YYYY UK format dates
    .Text = "[0-9]{1,2}[/-][0-9]{1,2}[/-][12][0-9]{3}>"
    .Replacement.Text = ""
  End With
  Do While .Find.Execute = True
    .Text = Format(.Text, "D MMMM YYYY")
    .Collapse wdCollapseEnd
  Loop
End With
With ActiveDocument.Range
  With .Find
    .MatchWildcards = True
    'Apply superscripted ordinals to all dates
    .Text = "<[0-9]{1,2} [JFMASOND][abceghilmnoprstuvy]{2,8}>"
    .Wrap = wdFindStop
  End With
  Do While .Find.Execute = True
    i = CLng(Split(.Text, " ")(0))
    .Text = Ordinal(i) & " " & Split(.Text, " ")(1)
    With .Duplicate
      .Start = .Start + Len(CStr(i))
      .End = .Start + 2
      .Font.Superscript = True
    End With
    .Collapse wdCollapseEnd
  Loop
End With
Application.ScreenUpdating = True
End Sub

Function Ordinal(i As Long) As String
Dim strOrd As String
If (i Mod 100) < 11 Or (i Mod 100) > 13 Then strOrd = Choose(i Mod 10, "st", "nd", "rd") & ""
Ordinal = i & IIf(strOrd = "", "th", strOrd)
End Function
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote