![]() |
|
#2
|
||||
|
||||
|
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] |
| Thread Tools | |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
| Mail merge field mistakenly interpret text format as date format | alan6690 | Mail Merge | 0 | 09-02-2020 01:54 AM |
| Find/Replace using format of cell | catflap | Excel | 1 | 09-11-2017 07:28 AM |
| Letter date changes when merging with Excel - not the format, the actual date! | Smallweed | Mail Merge | 1 | 02-07-2014 06:00 PM |
Find and Replace maintain format
|
winningson | Word | 3 | 01-19-2013 05:38 AM |
Find and Replace Format macro issue
|
Jack | Word VBA | 2 | 12-12-2012 09:24 PM |