Microsoft Office Forums - View Single Post

gmayor · 09-19-2023, 11:20 PM

Unfortunately date content controls do not cater for ordinal dates, however, you can use the control to select the date, then using a macro change the control type to Rich Text and format the selected date as required. In the thisdocument module of the document or its template add the following. Then when you leave the field it will be converted to display the field as required. The three lines that add the superscript are optional.
Click into the changed field to select a new date.

Code:

Option Explicit
'Graham Mayor - https://www.gmayor.com - Last updated - 20 Sep 2023

Private Const sList As String = "0123456789"

Private Sub Document_ContentControlOnEnter(ByVal ContentControl As ContentControl)
Dim oRng As Range
Dim dDate As Date
    Select Case ContentControl.Title
        Case Is = "Date" 'The title of the date field
            If ContentControl.ShowingPlaceholderText = False Then
                If ContentControl.Type = wdContentControlRichText Then
                    Set oRng = ContentControl.Range
                    oRng.MoveStartWhile sList
                    oRng.End = oRng.Start + 5
                    oRng.Text = ""
                    Set oRng = ContentControl.Range
                    dDate = oRng.Text
                    ContentControl.Type = wdContentControlDate
                    oRng.Text = Format(dDate, "dd/MM/yyyy")
                End If
            End If
    End Select
End Sub

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim oRng As Range
Dim dDate As Date
    Select Case ContentControl.Title
        Case Is = "Date" 'The title of the date field
            If ContentControl.ShowingPlaceholderText = False Then
                If ContentControl.Type = wdContentControlDate Then
                    Set oRng = ContentControl.Range
                    dDate = CDate(oRng.Text)
                    ContentControl.Type = wdContentControlRichText
                    oRng.Text = Format(dDate, "d") & DateOrdinal(Format((dDate), "d")) & _
                        " of " & Format((dDate), "MMMM yyyy")
                    oRng.MoveStartWhile sList
                    oRng.End = oRng.Start + 2
                    oRng.Font.Superscript = True
                End If
            End If
    End Select
End Sub

Private Function DateOrdinal(Val As Long) As String
'Paul Edstein
Dim strOrd As String
    If (Val Mod 100) < 11 Or (Val Mod 100) > 13 Then strOrd = Choose(Val Mod 10, "st", "nd", "rd") & ""
    DateOrdinal = IIf(strOrd = "", "th", strOrd)
lbl_Exit:
    Exit Function
End Function