Consulting

Results 1 to 10 of 10

Thread: Ordinal Created Date

  1. #1

    Ordinal Created Date

    Is there a way using VBA that the 'created date' (Gregorian Calendar) can be added that includes the ordinal? Word seems to let you get near to what I'm after, but just falls short with this minor detail.

    I'm after something that will produce for example Wednesday 14th September 2020 or Monday 31st July 2020 or Thursday 3rd April 2020 or Saturday 2nd March 2020. If the ordinal could be superscript, this would be even better.

    The result would be populated to a Bookmark called 'CreatedDate'.

    Many thanks!

  2. #2
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,399
    Location
    You can use the Unicode characters


    Option Explicit
    
    
    ' Wednesday 14th September 2020
    Sub CreatedDate()
        Dim dateCreated As Date
        Dim dateBookmark As String
        Dim v As Variant
        Dim rBookmark As Range
        
        
        dateCreated = ThisDocument.BuiltInDocumentProperties("Creation Date")
    
    
        dateBookmark = Format(dateCreated, "dddd d mmmm yyyy")
        
        v = Split(dateBookmark, " ")
    
    
        Select Case v(1)    '   the d
            'st
            Case "1", "21", "31"
                v(1) = v(1) & ChrW(&H2E2) & ChrW(&H1D57)
            'nd
            Case "2", "22"
                v(1) = v(1) & ChrW(&H207F) & ChrW(&H1D48)
            'rd
            Case "3", "23"
                v(1) = v(1) & ChrW(&H2B3) & ChrW(&H1D48)
            'th
            Case Else
                v(1) = v(1) & ChrW(&H1D57) & ChrW(&H2B0)
        End Select
    
    
        dateBookmark = Join(v, " ")
        
        Set rBookmark = ThisDocument.Bookmarks("CreateDate").Range
        
        rBookmark.Text = dateBookmark
    
    
        ThisDocument.Bookmarks.Add "CreateDate", rBookmark
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    Exactly what I was looking for! Thank you.

  4. #4
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,218
    Location
    Paul,

    Interesting that I have been working the past week on an add-in to insert special format date content controls. If you would reach out via my website, I will send it to you for review. In my research, I found that dates with ordinals (at least in the US) are usually formated

    Sunday, the 9th of August 2020. With that is mind:

    Sub CreatedDate()
    Dim oDate As Date
    Dim oBMRng As Range
      oDate = ThisDocument.BuiltInDocumentProperties("Creation Date")
      Set oBMRng = ThisDocument.Bookmarks("CreateDate").Range
      oBMRng.Text = Format(oDate, "DDDD") & " the " & Format(oDate, "D") & _
                    fcnOrdinal(Format(oDate, "D")) & " of " & Format(oDate, "MMMM YYYY")
      oBMRng.NoProofing = True
      ThisDocument.Bookmarks.Add "CreateDate", oBMRng
    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
    Greg

    Visit my website: http://gregmaxey.com

  5. #5
    Or you could use a field construction

    {QUOTE{CREATEDATE \@ "dddd 'the' d"}{IF{=(MOD({={CREATEDATE \@ d}+89},100)>2)*(MOD({={CREATEDATE \@ d}+9},10)<3)}= 1 {=MOD({CREATEDATE \@ d},10)-2 \# rd;st;nd} th}{CREATEDATE \@ "' of' MMMM, yyyy"}}

    with the red parts superscripted and no need for VBA. Example courtesy of Paul Edstein's DateCalc document which you can download from https://www.gmayor.com/downloads.htm
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  6. #6
    VBAX Regular
    Joined
    Jul 2020
    Location
    Sun Prairie
    Posts
    14
    Location
    Quote Originally Posted by HTSCF Fareha View Post
    Is there a way using VBA that the 'created date' (Gregorian Calendar) can be added that includes the ordinal? Word seems to let you get near to what I'm after, but just falls short with this minor detail.

    I'm after something that will produce for example Wednesday 14th September 2020 or Monday 31st July 2020 or Thursday 3rd April 2020 or Saturday 2nd March 2020. If the ordinal could be superscript, this would be even better.

    The result would be populated to a Bookmark called 'CreatedDate'.

    Many thanks!
    Of course, rather than the bookmark, you could always just put a CREATEDATE field in your document/template where you want that date.

    I tried putting a link to my page on date fields but was blocked by the forum.

  7. #7
    This is what I am doing at the moment. I just wanted to add the ordinal. MS Word allows every conceivable combination of date, but not with an ordinal.

  8. #8
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,306
    Location
    With VBA
    Function OrdinalDate(Dte As Date) As String
    'Formatted as ISO 8601 ordinal date
    
    OrdinalDate = CStr(Year(Dte)) & "-" & CStr(DateDiff("d", "Jan 1," & Year(Dte), Dte) + 1)
    End Function
    Usage:
    X = OrdinalDate(Date)
    X = OrdinalDate(Now)
    X = OrdinalDate("12/7/1942")
    X = OrdinalDate(DateAdd("m", 3, Date)
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  9. #9
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    Posting for Chas

    Quote Originally Posted by HTSCF Fareha View Post
    This is what I am doing at the moment. I just wanted to add the ordinal. MS Word allows every conceivable combination of date, but not with an ordinal.
    If this was a response to my suggestion to use a createdate field, you definitely can use a field for ordinals.
    These can be complex if you want superscript but can be saved as AutoText/QuickParts for future use.
    My old Legal Toolbars Add-In has them.


    To produce Saturday the 15th of August, 2020 {QUOTE{CREATEDATE \@ "dddd 'the' d"}{IF{=(mod({CREATEDATE \@ d},10)<4)*(mod({CREATEDATE \@ d},10)<>0)*({CREATEDATE \@ d}<>11)*({CREATEDATE \@ d}<>12)*({CREATEDATE \@ d}<>13)}= 1 {=mod({CREATEDATE \@ d},10)-2 \# rd;st;nd} th}{ CREATEDATE \@ "' of' MMMM, yyyy" }}

    To produce Saturday the 15th of August, 2020 { CreateDate \@ dddd } the {CreateDate \@ d \* ordinal } of {CreateDate \@ "MMMM, yyyy" }

    I am sure that I received help on this, but it was a long time ago that I created that Add-In. I suspect the help was from macropod.
    I am not able to post links here or I would post a link to his advice on a similar field.

  10. #10
    Quote Originally Posted by gmaxey View Post
    Paul,

    Interesting that I have been working the past week on an add-in to insert special format date content controls. If you would reach out via my website, I will send it to you for review. In my research, I found that dates with ordinals (at least in the US) are usually formated

    Sunday, the 9th of August 2020. With that is mind:

    Sub CreatedDate()
    Dim oDate As Date
    Dim oBMRng As Range
      oDate = ThisDocument.BuiltInDocumentProperties("Creation Date")
      Set oBMRng = ThisDocument.Bookmarks("CreateDate").Range
      oBMRng.Text = Format(oDate, "DDDD") & " the " & Format(oDate, "D") & _
                    fcnOrdinal(Format(oDate, "D")) & " of " & Format(oDate, "MMMM YYYY")
      oBMRng.NoProofing = True
      ThisDocument.Bookmarks.Add "CreateDate", oBMRng
    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
    I've just realised that I had forgotten to follow this one up. Apologies, gmaxey!

    In the UK one would expect this to be the format

    Sunday 9th August 2020

    Tweaked the code ever so slightly. This produces the "created date".

    Sub CreatedDate()
    Dim oDate As Date
    Dim oBMRng As Range
      oDate = ThisDocument.BuiltInDocumentProperties("Creation Date")
      Set oBMRng = ThisDocument.Bookmarks("CreateDate").Range
      oBMRng.Text = Format(oDate, "DDDD") & " " & Format(oDate, "D") & _
                    fcnOrdinal(Format(oDate, "D")) & " " & Format(oDate, "MMMM YYYY")
      oBMRng.NoProofing = True
      ThisDocument.Bookmarks.Add "CreateDate", oBMRng
    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
    This works fine on its own in a document. However, trying to add it to this form it doesn't add the date, despite inserting the Bookmark.
    http://www.vbaexpress.com/forum/showthread.php?67825-Selecting-a-team-from-a-ListBox/page3

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •