Code that writes special date inside the document

[student123]

Dear colleagues,

This is a code for a special date format that was developed by Paul_Hossler and SamT (in thread: [SOLVED] Making Your Own Date Format).
It shows the date in special format in UserForm1.

Is there a way to make it like this that when you open this document it would write the the special date not in UserForm but in specific place (marked as yellow) in the 14961? Or maybe it's possible to assign it to {TIME \@ SpecialDateFormat} with auto update?


Option Explicit

'Developed by Paul_Hossler and SamT
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, _
ByVal LCType As Long, _
ByVal lpLCData As String, _
ByVal cchData As Long) As Long


Public Const LOCALE_USER_DEFAULT As Long = &H400
Public Const LOCALE_SABBREVLANGNAME As Long = &H3


Public aMonthNames As Variant
Public MonthWord As String
Public aDayNumbers As Variant
Public DayWord As String

Public Const U_caron As Long = &H16B
Public Const Z_caron As Long = &H17E
Public Const E_caron As Long = &H117
Public Const S_caron As Long = &H161
Public Const C_caron As Long = &H10D



Sub driver()
MsgBox SpecialDateFormat(DateSerial(2015, 11, 20)) 'use UserForm1
End Sub

Function SpecialDateFormat(Dt As Date)
SetArrays
SpecialDateFormat = _
aMonthNames(Month(Dt) - 1) & _
" " & MonthWord & _
" " & aDayNumbers(Day(Dt) - 1) & _
" " & DayWord
End Function


Private Function SetArrays()
Dim sLang As String
Dim i As Long

sLang = GetInfo(LOCALE_SABBREVLANGNAME)

Select Case sLang
Case "LTH"
aMonthNames = Array("sausio", "vasario", "kovo", "baland" & ChrW(Z_caron) & "io", "gegu" & ChrW(Z_caron) & ChrW(E_caron) & "s", "bir" & ChrW(Z_caron) & "elio", _
"liepos", "rugpj" & ChrW(U_caron) & ChrW(C_caron) & "io", "rugs" & ChrW(E_caron) & "jo", "spalio", "lapkri" & ChrW(C_caron) & "io", "gruod" & ChrW(Z_caron) & "io")
MonthWord = "m" & ChrW(E_caron) & "nesio"
aDayNumbers = Array("pirma", "antra", "tre" & ChrW(C_caron) & "ia", "ketvirta", "penkta", ChrW(S_caron) & "e" & ChrW(S_caron) & "ta", "septinta", _
"a" & ChrW(S_caron) & "tunta", "devinta", "de" & ChrW(S_caron) & "imta", "vienuolikta", "dvylikta", "trylikta", "keturiolikta", "penkiolikta", _
ChrW(S_caron) & "e" & ChrW(S_caron) & "iolikta", "septyniolikta", "a" & ChrW(S_caron) & "tuoniolikta", "devyniolikta", "dvidešimta", "dvidešimt pirma", "dvidešimt antra", _
"dvidešimt tre" & ChrW(C_caron) & "ia", "dvidešimt ketvirta", "dvidešimt penkta", "dvidešimt šešta", "dvidešimt septinta", _
"dvidešimt aštunta", "dvidešimt devinta", "trisdešimta", "trisdešimt pirma")
DayWord = "diena"

Case "ENU"
aMonthNames = Array("January", "February", "March", "April", "May", "June", _
"July", "Auguet", "September", "October", "November", "December")
MonthWord = "month"
aDayNumbers = Array("first", "second", "third", "fourth", "fifth", "sixth", "seventh", _
"eighth", "ninth", "tenth", "eleventh", "twelfth", "thirteenth", "fourteenth", "fifteenth", _
"sixteenth", "seventeenth", "eighteenth", "nineteenth", "twentieth", "twenty-first", "twenty-second", _
"twenty-third", "twenty-fourth", "twenty-fifth", "twenty-sixth", "twenty-seventh", _
"twenty-eighth", "twenty-ninth", "thirtieth", "thirty-first")
DayWord = "day"

Case Else
MsgBox "Oops"
End Select
End Function


Private Function GetInfo(ByVal lInfo As Long) As String
Dim Buffer As String
Dim ret As String
Buffer = String$(256, 0)
ret = GetLocaleInfo(LOCALE_USER_DEFAULT, lInfo, Buffer, Len(Buffer))
If ret > 0 Then
GetInfo = Left$(Buffer, ret - 1)
Else
GetInfo = vbNullString
End If
lbl_Exit:
Exit Function
End Function

The code of the UserForm1


Option Explicit

Private Sub Label1_Click()

End Sub

Private Sub UserForm_Initialize()

Me.Label1.Caption = SpecialDateFormat(DateSerial(2015, 12, 31))
End Sub




M. Office 2013

[Paul_Hossler]

The easiest way I know is to

1. insert document variable fields where you want the special date to go,
2. in the document open generate the special string
3. update the fields




Option Explicit

Private Sub Document_Open()
Dim s As String

s = SpecialDateFormat(DateSerial(2016, 5, 14))

With ActiveDocument.Variables
On Error Resume Next
.Item("SpecialFormattedDate").Delete
On Error GoTo 0
Call .Add("SpecialFormattedDate", s)
End With
Selection.WholeStory
Selection.Fields.Update

End Sub



Alt-F9 toggles between view and hide field codes

[student123]

Hi Paul!
It works! Thank you! :clap2:
I am so grateful for the people who created this forum and for the people who are keeping it alive! :beerchug:

Zygis