Formating Date Entry Via UserForm

[HTSCF Fareha]

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.

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

[gmayor]

The simplest approach is to store the date in the document, e.g. using a docproperty field. Then the format of the content control is irrelevant.
I have added in Trevor Eyre's excellent date picker, which is better than expecting users to enter dates as text. The more user errors you can avoid the better.
See attached.

[HTSCF Fareha]

My sincere thanks as ever, Graham!

This is a much better way of entering a date and as you say, helps to eliminate potential errors in date entry by the user.

Alas, it would appear that although the date on the UserForm indicates a UK format of DD/MM/YYYY, when the "Update Document" button is pressed, it shows the date in US format of MM/DD/YYYY. If you run the UserForm again without changing the date, it then updates the document with the UK locale. In fact, each time you press the "Update Document" without changing the date, it flips between UK and US formats and swapping the day / month.

[Bob Phillips]

Graham,

That is quite a nice date picker, but I did find a couple of bugs in the APIs on Win 64 systems, as I have.

The RemoveTitlebar seems just 32-bit compatible

Private Sub RemoveTitleBar()
Dim lStyle As Long
Dim hMenu As Long
Dim mhWndForm As Long

    mhWndForm = FindWindow("ThunderDFrame", Caption)
    lStyle = GetWindowLong(mhWndForm, -16)
    lStyle = lStyle And Not &HC00000
    SetWindowLong mhWndForm, -16, lStyle
    DrawMenuBar mhWndForm

    Height = Height - 24 + (Height - InsideHeight)
lbl_Exit:
    Exit Sub
End Sub

It also needs to check for 64 bit as set the pointers as LongPtr

Private Sub RemoveTitleBar()
#If VBA7 Then
Dim lStyle As LongPtr
Dim hMenu As LongPtr
Dim mhWndForm As LongPtr

    mhWndForm = FindWindow("ThunderDFrame", Caption)
    lStyle = GetWindowLong(mhWndForm, -16)
    lStyle = lStyle And Not &HC00000
    SetWindowLong mhWndForm, -16, lStyle
    DrawMenuBar mhWndForm
#Else
Dim lStyle As Long
Dim hMenu As Long
Dim mhWndForm As Long

    mhWndForm = FindWindow("ThunderDFrame", Caption)
    lStyle = GetWindowLong(mhWndForm, -16)
    lStyle = lStyle And Not &HC00000
    SetWindowLong mhWndForm, -16, lStyle
    DrawMenuBar mhWndForm
#End If
    Height = Height - 24 + (Height - InsideHeight)
End Sub

In the API defs, DrawMenuBar in the VBA7 conditional section was defined in the Win64 conditional sectional, but not the other. As it happens, I am not sure why that Win64 conditional sectional is there at all, VBA7 handles it all

#If VBA7 Then
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
        ByVal hwnd As LongPtr, _
        ByVal nIndex As LongPtr) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
        ByVal hwnd As LongPtr, _
        ByVal nIndex As LongPtr, _
        ByVal dwNewLongptr As LongPtr) As LongPtr
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
#Else
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
                                    ByVal lpClassName As String, _
                                    ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
                                       ByVal hwnd As Long, _
                                       ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
                                       ByVal hwnd As Long, _
                                       ByVal nIndex As Long, _
                                       ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
#End If

Apologies if grandma ... suck eggs and all that, but if you are Win32 you may not have noticed that, and sharing with 64 bit clients may give problems.

[arnelgp]

the difference:

win64 constant that check if the OS is 64 bit
win32 constant that check if the OS is 32 bit
VBA7 check if your Office is 2010 or Later (regardless if 32 or 64)

64-bit Visual Basic for Applications overview | Microsoft Docs

also not all Long is needed to be converted to Longptr.
you only use them for pointers and window handle
as described in the link.

[gmayor]

@HTSCF Fareha I don't see the date flipping issue here, but I have modified the code to give a belt and braces setting of the format.

@Bob Phillips Of course you are right about the 64 bit issue. Unfortunately I copied an older version which included the title bar code, rather than the version I normally use, which has the title bar code in a separate module and is 64 bit compatible. I have swapped it out in the example. I will also update my old copy of the date picker code. Thanks for bringing it to my attention.
The date picker was created originally for Excel by Trevor Eyre and my friend and occasional forum contributor Greg Maxey and I adapted it, with Trevor's approval, to work with Word. I particularly like this date picker because it is highly configurable to user requirements and have used it in several of my own projects.

[HTSCF Fareha]

Unfortunately for me this is still throwing up the same problem. I've produced several screen shots that show what happens at each stage.

1.jpg
Initial opening of document.

2.jpg
Selection of date. All good.

3.jpg
Date shown in box. All good.

4.jpg
Pressing "Update document". Here's the error. Note the day / month have flipped position.

5.jpg
Click again on "Click here to test code". Note the day / month have flipped position in the box.

6.jpg
Without altering anything, press "Update document".

7.jpg

Pressing "Update document" once again.

I'm hoping that this might help identify where the problem is arising?


[EDIT] I've even tried removing all the formating of the date in ModMain and this still gives the same result.

[gmayor]

OK I can reproduce this with dates that could be ambiguous like the one you chose. it doesn't occur with non-ambiguous dates like 16/01/22. I'll have to give this a little thought to determine where the problem lies.

[gmayor]

If you change the line

oDoc.CustomDocumentProperties.Add Name:="Report Date", _
                                              LinkToContent:=False, _
                                              Value:=Format(.txtRptDate.Text, "dd/mm/yyyy"), _
                                              Type:=3

to

oDoc.CustomDocumentProperties.Add Name:="Report Date", _
                                              LinkToContent:=False, _
                                              Value:=Format(.txtRptDate.Text, "dd/mm/yyyy"), _
                                              Type:=4

The problem doesn't occur. See attached.

[HTSCF Fareha]

My thanks, Graham.

Sorry for the hassle, but I'm hoping that you will find a solution.

[gmayor]

Now fixed - see my last post.

[HTSCF Fareha]

Sorry Graham, was typing my post at the same time as you.

The problem has now indeed been solved. Thank you for your time and perseverence!

[Bob Phillips]

the difference:

win64 constant that check if the OS is 64 bit
win32 constant that check if the OS is 32 bit
VBA7 check if your Office is 2010 or Later (regardless if 32 or 64)

64-bit Visual Basic for Applications overview | Microsoft Docs

also not all Long is needed to be converted to Longptr.
you only use them for pointers and window handle
as described in the link.

I suggest that you read Jan Karel's article, https://jkp-ads.com/Articles/apideclarations.asp, for people who use it in the real world rather than the theory.

[Bob Phillips]

@Bob Phillips Of course you are right about the 64 bit issue. Unfortunately I copied an older version which included the title bar code, rather than the version I normally use, which has the title bar code in a separate module and is 64 bit compatible. I have swapped it out in the example. I will also update my old copy of the date picker code. Thanks for bringing it to my attention.
The date picker was created originally for Excel by Trevor Eyre and my friend and occasional forum contributor Greg Maxey and I adapted it, with Trevor's approval, to work with Word. I particularly like this date picker because it is highly configurable to user requirements and have used it in several of my own projects.

I must admit to not having seen it before, it is quite a nice and flexible date picker. I am adapting it a tad to be a bit more to my tastes (tick and x buttons rather than OK and Cancel, having a sink event class for all of the number and background buttons, and so on), then it will become my go-to date picker - I will of course leave attributes to Trevor in there.

Can I ask, what changes were required specifically for Word?

I beleiev that you live in Cyprus Graham, so maybe not, but have we ever met at a Microsoft event, either Reading or Seattle?

[arnelgp]

there is also a word calendar that does not require a lot of code.
i am not the author of this and can't recall where i get this.
credit to the owner.

[gmayor]

I must admit to not having seen it before, it is quite a nice and flexible date picker. I am adapting it a tad to be a bit more to my tastes (tick and x buttons rather than OK and Cancel, having a sink event class for all of the number and background buttons, and so on), then it will become my go-to date picker - I will of course leave attributes to Trevor in there.
Can I ask, what changes were required specifically for Word?
I believe that you live in Cyprus Graham, so maybe not, but have we ever met at a Microsoft event, either Reading or Seattle?

The changes for Word were primarily changes of references from Worksheet to Document.
I have lived in Cyprus for many years, though am in the process of repatriating back to the UK, which has been severely hampered by the COVID panic.
When I was MVP, I never bothered with the events as I am retired and now program primarily to amuse myself. I couldn't justify the cost for a jolly.