Formating Date Entry Via UserForm
I have a couple of things that I'd like some help in addressing please.
I have a textbox on my UserForm called txtRptDate, which as its name suggests is for the user to input a date (UK format), as for example 10/01/2022.
Code in the module will then convert this to DDDD DD MMMM. So that this formats it to read Monday 10 January. The sub ReportedDate is meant to then format the date so that an ordinal is applied, as that which is called earlier to apply the same to the content control on the Active Document Property "created date" in the sub CreatedDate.
CreatedDate is working fine and does as it should, but I think I'm missing something as the same cannot be said for ReportedDate. I cannot get the ordinal part to work on this.
My second part is a question about if the user selects a ribbon button that I have to enable editing of the UserForm again. The date that was entered in txtRptDate will show for example Monday 10th January (hopefully) if this i utilized. Is there a way to maintain for UserForm purposes, the initially entered format of DD/MM/YYYY, but which will then still work to produce Monday 10th January when the "Enter" button is pressed?
Here is my code which I have stripped back to only include the main sub (hence only one "case") with only the code for the RptDate, two date subs and the function. Please note that the CreatedDate works perfectly already.
Code:
Option Explicit
Sub CreateDoc()
Dim oDoc As Document
Dim oRng As Range
Dim oVar As Variable
Dim oCtrl As Control
Dim occ As ContentControl
Dim oFrmNFA As frmNFA
Dim sCC As String
If ActiveDocument = ThisDocument Then
MsgBox "You cannot use this function to edit the document template", vbCritical
Exit Sub
End If
'*** Call CreatedDate procedure
CreatedDate
Set oDoc = ActiveDocument
Set oFrmNFA = New frmNFA
With oFrmNFA
For Each occ In oDoc.ContentControls
If occ.ShowingPlaceholderText = False Then
Select Case occ.Title
Case "Report Date"
.txtRptDate.Text = occ.Range.Text
End Select
End If
Next occ
.Show
If .Tag = 0 Then GoTo lbl_Exit
For Each occ In oDoc.ContentControls
Set oRng = occ.Range
Select Case occ.Title
Case "Report Date"
oRng.Text = .txtRptDate.Text
oRng.Text = Format(.txtRptDate.Text, "DDDD DD MMMM")
'*** Call ReportedDate procedure
ReportedDate
End Select
Next occ
End With
lbl_Exit:
Unload oFrmNFA
Set oFrmNFA = Nothing
Set oRng = Nothing
Set occ = Nothing
Set oDoc = Nothing
Exit Sub
End Sub
Sub CreatedDate()
Dim oDate As Date
Dim occ As ContentControl
oDate = ActiveDocument.BuiltInDocumentProperties("Creation Date")
Set occ = ActiveDocument.SelectContentControlsByTitle("Date").Item(1)
occ.Range.Text = Format(oDate, "DDDD") & " " & Format(oDate, "D") & _
fcnOrdinal(Format(oDate, "D")) & " " & Format(oDate, "MMMM YYYY")
occ.Range.NoProofing = True
lbl_Exit:
Exit Sub
End Sub
Sub ReportedDate()
Dim oReportDate As Date
Dim occ As ContentControl
oReportDate = occ("Report Date")
Set occ = ActiveDocument.SelectContentControlsByTitle("Report Date").Item(1)
occ.Range.Text = Format(oReportDate, "DDDD") & " " & Format(oReportDate, "D") & _
fcnOrdinal(Format(oReportDate, "D")) & " " & Format(oReportDate, "MMMM YYYY")
occ.Range.NoProofing = True
lbl_Exit:
Exit Sub
End Sub
Function fcnOrdinal(lngDay As Long) As String
'Adaptation from code used by macropod
Dim strOrd As String
If (lngDay Mod 100) < 11 Or (lngDay Mod 100) > 13 Then strOrd = _
Choose(lngDay Mod 10, ChrW(&H2E2) & ChrW(&H1D57), ChrW(&H207F) & ChrW(&H1D48), ChrW(&H2B3) & ChrW(&H1D48)) & ""
fcnOrdinal = IIf(strOrd = "", ChrW(&H1D57) & ChrW(&H2B0), strOrd)
lbl_Exit:
Exit Function
End Function
