Magic_Doctor
04-10-2021, 12:00 PM
Hello,
Sorry for not responding earlier.
Okay, so I took your advice. I split the function into 2 parts with, for each, a maximum of 150 languages. Everything is now working perfectly fine, except for one case.
When choosing a language, whatever it is, the name of the day of the week appears as expected. If this language is in an incomprehensible alphabet, then its Latinized transcription appears. But, when the chosen language is in the second function (and only in the second function), it does not work. Oddly enough, the search for the Latinized equivalent is not done in the second function, but only in the first function. For example: the language "Sängö" is the first language of the second function which contains the different languages (beyond 150). This language does not need to be Latinized, but I end up with the first language of the first function ("Abkhaz") which it must be Latinized; therefore appears the Latinized transcription of "Abkhaz" ... If I now choose "Yiddish" (still in the second function) which is in a Hebrew alphabet, its Latinized transcription does not appear, since the search is done in the first function.
I looked for a long time to resolve this problem, but it was unsuccessful.
The function:
Function NomJourSemaineTrip$(Optional fecha As Date, Optional ChxLangue%, Optional NomLangue As Byte, Optional NbItems As Boolean = False, Optional transcription As Boolean = False, Optional LangueBase As Byte)
'Returns the day of the week corresponding to a date
'- fecha : a date
'- ChxLangue : Choice of language. Ex: 1 -> Abkhaze | 2 -> Afrikaans | 3 -> Alabama | ...
'- NomLangue : 1 --> name of the language chosen in the matrix "langue"
' 2 --> day of the week, corresponding to the date "fecha", in the "LangueRef" matrix
' 3 --> name of the language understandable in the "LanguageRef" matrix
'- NbItems : if True --> number of languages listed in the function
'- transcription : if True --> checks if the chosen language is in an esoteric alphabet (Greek, Cyrillic ...) and searches for its latinized transcription
'- LangueBase : 1 -> "LangueRef" matrix for French | 2 -> "LangueRef" matrix for Spanish | ...
'WARNING! After any modification, do not forget to update "NbLangues" & the "Case" of "latinization"
'Magic_Doctor
If ChxLangue <= 150 Then
NomJourSemaineTrip = BlocLangues1(fecha, ChxLangue, NomLangue, NbItems, transcription, LangueBase)
Else
ChxLangue = ChxLangue - 150
NomJourSemaineTrip = BlocLangues2(fecha, ChxLangue, NomLangue, NbItems, transcription, LangueBase)
End If
End Function
Function BlocLangues1$(Optional fecha As Date, Optional ChxLangue%, Optional NomLangue As Byte, Optional NbItems As Boolean = False, Optional transcription As Boolean = False, Optional LangueBase As Byte)
'Returns the day of the week corresponding to a date
'Limited to 150 languages
'- fecha : a date
'- ChxLangue : Choice of language. Ex: 1 -> Abkhaze | 2 -> Afrikaans | 3 -> Alabama | ...
'- NomLangue : 1 --> name of the language chosen in the matrix "langue"
' 2 --> day of the week, corresponding to the date "fecha", in the "LangueRef" matrix
' 3 --> name of the language understandable in the "LanguageRef" matrix
'- NbItems : if True --> number of languages listed in the function
'- transcription : if True --> checks if the chosen language is in an esoteric alphabet (Greek, Cyrillic ...) and searches for its latinized transcription
'- LangueBase : 1 -> "LangueRef" matrix for French | 2 -> "LangueRef" matrix for Spanish | ...
'WARNING! After any modification, do not forget to update "NbLangues" & the "Case" of "latinization"
'Magic_Doctor
Dim langue, NbLangues As Byte, latinisation, LangueRef
'Basic languages (understandable)
Select Case LangueBase
Case 1: LangueRef = Array("Dimanche", "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Français")
Case 2: LangueRef = Array("Domingo", "Lunes", "Martes", "Miércoles", "Jueves", "Viernes", "Sábado", "Espagnol")
Case 3: LangueRef = Array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Anglais")
Case 4: LangueRef = Array("Domingo", "Segunda-feira", "Terça-feira", "Quarta-feira", "Quinta-feira", "Sexta-feira", "Sábado", "Portugais")
End Select
'Set of languages with which we want to indicate the names of the days of the week (whatever their alphabet)
Select Case ChxLangue
Case 1: langue = Array(ChrW(1040) & ChrW(1084) & ChrW(1213) & ChrW(1100) & ChrW(1231) & ChrW(1096), _
ChrW(1040) & ChrW(1096) & ChrW(1241) & ChrW(1072) & ChrW(1093) & ChrW(1100), _
ChrW(1040) & ChrW(1193) & ChrW(1072) & ChrW(1096), _
ChrW(1040) & ChrW(1093) & ChrW(1072) & ChrW(1096), _
ChrW(1040) & ChrW(1191) & ChrW(1096) & ChrW(1100) & ChrW(1072) & ChrW(1096), _
ChrW(1040) & ChrW(1093) & ChrW(1241) & ChrW(1072) & ChrW(1096), _
ChrW(1040) & ChrW(1089) & ChrW(1072) & ChrW(1073) & ChrW(1096), "Abkhaze")
Case 2: langue = Array("Sonndag", "Maandag", "Dinsdag", "Woensdag", "Donderdag", "Vrydag", "Saterdag", "Afrikaans")
Case 3: langue = Array("Nihtahollo", "Nihta a" & ChrW(620) & ChrW(620) & "ámmòona", "Nihta atòkla", "Nihta atótchìina", "Nihta istóstàaka", "Nihta istá" & ChrW(620) & ChrW(620) & "àapi", "Nihtahollosi", "Alabama")
Case 4: langue = Array("E diel", "E hënë", "E martë", "E mërkurë", "E enjte", "E premte", "E shtunë", "Albanais")
Case 5: langue = Array("Sonntag", "Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag", "Allemand")
Case 6: langue = Array("Sonndich", "Mendich", "Denschdich", "Mittich", "Donnerschtich", "Fraidich", "Samschdich", "Allemand (Bavarois)")
Case 7: langue = Array("Sunntig", "Määntig", "Ziischtig", "Mittwuch", "Dunschtig", "Friitig", "Samschtig", "Allemand (Suisse)")
Case 8: langue = Array("Sunndi", "Mandi", "Zischdi", "Mittwuch", "Dunnerschdi", "Fridi", "Sàmschdi", "Alsacien")
Case 9: langue = Array(ChrW(&H12A5) & ChrW(&H1211) & ChrW(&H12F5), _
...
Case 144: langue = Array("S" & ChrW(229) & "dn" & ChrW(229) & "biejvve", "Lávvodahka", "Mánnodahkaa", "Dijstahka", "Gasskavahkkoò", "Duorastahka", "Bierjjedahka", "Same (de Lule)")
Case 145: langue = Array("Sotnabeaivi", "Vuossárga", "Ma" & ChrW(331) & ChrW(331) & "ebárga", "Gaskavahkku", "Duorastat", "Bearjadat", "Lávvardat", "Same (du Nord)")
Case 146: langue = Array(ChrW(198) & "jlege", "Maanta", "Dæjsta", "Gaskev" & ChrW(229) & "hkoe", "Duarsta", "Bearjadahke", "Laavvardahke", "Same (du Sud)")
Case 147: langue = Array("Pasepeivi", "Vuossargâ", "Majebargâ", "Koskokko", "Tuorâstâh", "Vástuppeivi", "Lávárdâh", "Same (Inari)")
Case 148: langue = Array("Pâ'sspei'vv", "Vu" & ChrW(&HF5) & "ssargg", "Mââi'bargg", "Seärad", "Nelljdpei'vv", "Piâtnâc", "Sue'vet", "Same (Skolt)")
Case 149: langue = Array("Aso S" & ChrW(257), "Aso Gafua", "Aso Lua", "Aso Lulu", "Aso Tofi", "Aso Faraile", "Aso To’ona’i", "Samoan")
Case 150: langue = Array("Nediel" & ChrW(279) & "s d" & ChrW(279) & "ina", "Panedielis", "Oterninks", "Sereda", "Ketvergs", "Perdreau", "Sobata", "Samogitien")
End Select
'WARNING! if you add a new language, move the last language to the function "BlocLangues2" so as not to exceed 150 languages
NbLangues = 150 'number of languages listed in the function
If transcription Then 'the chosen language is in an abstruse alphabet
'WARNING! Each "Case" must bear the same number as that of the language in the esoteric alphabet which is latinized
'Set of languages in abstruse alphabets that are latinized
Select Case ChxLangue
Case 1: latinisation = Array("Amçy" & ChrW(353), "A" & ChrW(353) & ChrW(1241) & "ax’", "Aoa" & ChrW(353), "Axa" & ChrW(353), "A" & ChrW(&H1E57) & ChrW(353) & "'a" & ChrW(353), "Ax" & ChrW(1241) & "a" & ChrW(353), "Asab" & ChrW(353), "Abkhaze")
Case 9: latinisation = Array("Ehud", "Senyo", "Maksenyo", "Voler", "Hamus", "Aarb", "Kidami", "Amharique")
Case 13: latinisation = Array("Kiraki", "Erku" & ChrW(353) & "abt'i", "Erek'" & ChrW(353) & "abt'i", ChrW(268) & "orek" & ChrW(353) & "abt'i", "Hing" & ChrW(353) & "abt'i", "Urbat '", "Sabat '", "Arménien")
Case 23: latinisation = Array("Nedelja", "Ponedelnik", "Vtornik", "Srjadá", ChrW(268) & "etv" & ChrW(259) & "rt" & ChrW(259) & "k", "Pet" & ChrW(259) & "k", "S" & ChrW(259) & "bota", "Bulgare")
Case 61: latinisation = Array("Kvira", "Or" & ChrW(353) & "abat'i", "Sam" & ChrW(353) & "abat'i", "Ot'x" & ChrW(353) & "abat'i", "Xut'" & ChrW(353) & "abat'i", "Paraskevi", ChrW(352) & "abat'i", "Géorgien")
Case 62: latinisation = Array("Kyriak" & ChrW(7703), "Deytéra", "Trít" & ChrW(275), "Tetárt" & ChrW(275), "Pémpt" & ChrW(275), "Paraskey" & ChrW(7703), "Sávvato", "Grec")
Case 70: latinisation = Array("Yôm ri'" & ChrW(353) & "ôn", "Yôm " & ChrW(353) & "enî", "Yôm " & ChrW(353) & "lî" & ChrW(353) & "î", "Yôm rvî" & ChrW(&H2BF) & "î", "Yôm hamî" & ChrW(353) & "î", "Yôm " & ChrW(353) & "i" & ChrW(353) & "î", "Yôm " & ChrW(353) & "abat", "Hébreu")
Case 78: latinisation = Array("Nichiy" & ChrW(333) & "bi", "Getsuy" & ChrW(333) & "bi", "Kay" & ChrW(333) & "bi", "Suiy" & ChrW(333) & "bi", "Mokuy" & ChrW(333) & "bi", "Kiny" & ChrW(333) & "bi", "Doy" & ChrW(333) & "bi", "Japonais")
Case 82: latinisation = Array("Zheksenbe", "Düysenbi", "Seysenbi", "Särsenbi", "Beysenbi", "Juma", "Senbi", "Kazakh")
Case 84: latinisation = Array("Jek" & ChrW(&H219) & "embi", "Dü" & ChrW(&H219) & "ömbü", ChrW(&H218) & "ey" & ChrW(&H219) & "embi", ChrW(&H218) & "ar" & ChrW(&H219) & "embi", "Bey" & ChrW(&H219) & "embi", "Juma", "I" & ChrW(&H219) & "embi", "Kirghize")
Case 89: latinisation = Array("Al" & ChrW(&H1E29) & "at", "Itni", "Ttalat", "Arva" & ChrW(&H1E29), "Xamis", "Nju" & ChrW(382) & "mar", "Xxullun", "Lak")
Case 115: latinisation = Array("duminic" & ChrW(259), "Luni", "Mar" & ChrW(355) & "i", "Miercuri", "Joi", "Vineri", "Sâmb" & ChrW(259) & "t" & ChrW(259), "Moldave")
Case 117: latinisation = Array("Nyam", "Davaa", "Myagmar", "Lkhagva", "Pürev", "Baasan", "Byamba", "Mongol")
Case 142: latinisation = Array("Voskresen’ye", "Ponedel’nik", "Vtornik", "Sreda", "Chetverk", "Pyatnitsa", "Subbota", "Russe")
End Select
On Error Resume Next 'otherwise, oddly enough, it crashes
BlocLangues1 = latinisation(Weekday(fecha) - 1) 'latinized day of the week (Base Option 0). If not -> ""
ElseIf NbItems Then
BlocLangues1 = NbLangues 'total number of languages listed in the function
ElseIf NomLangue = 1 Then
BlocLangues1 = langue(7) 'name of the chosen language
ElseIf NomLangue = 2 Then
BlocLangues1 = LangueRef(Weekday(fecha) - 1) 'day of the week, corresponding to the date "fecha", in an understandable language (Option Base 0)
ElseIf NomLangue = 3 Then
BlocLangues1 = LangueRef(7) 'understandable language name
Else
BlocLangues1 = langue(Weekday(fecha) - 1) 'day of the week, corresponding to the date "fecha", in the chosen language (Base Option 0)
End If
End Function
Function BlocLangues2$(Optional fecha As Date, Optional ChxLangue%, Optional NomLangue As Byte, Optional NbItems As Boolean = False, Optional transcription As Boolean = False, Optional LangueBase As Byte)
'Renvoie le jour de la semaine correspondant à une date
'Returns the day of the week corresponding to a date
'Limited to 150 languages
'- fecha : a date
'- ChxLangue : Choice of language. Ex: 1 -> Abkhaze | 2 -> Afrikaans | 3 -> Alabama | ...
'- NomLangue : 1 --> name of the language chosen in the matrix "langue"
' 2 --> day of the week, corresponding to the date "fecha", in the "LangueRef" matrix
' 3 --> name of the language understandable in the "LanguageRef" matrix
'- NbItems : if True --> number of languages listed in the function
'- transcription : if True --> checks if the chosen language is in an esoteric alphabet (Greek, Cyrillic ...) and searches for its latinized transcription
'- LangueBase : 1 -> "LangueRef" matrix for French | 2 -> "LangueRef" matrix for Spanish | ...
'WARNING! After any modification, do not forget to update "NbLangues" & the "Case" of "latinization"
'Magic_Doctor
Dim langue, NbLangues As Byte, latinisation, LangueRef
'Basic languages (understandable)
Select Case LangueBase
Case 1: LangueRef = Array("Dimanche", "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Français")
Case 2: LangueRef = Array("Domingo", "Lunes", "Martes", "Miércoles", "Jueves", "Viernes", "Sábado", "Espagnol")
Case 3: LangueRef = Array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Anglais")
Case 4: LangueRef = Array("Domingo", "Segunda-feira", "Terça-feira", "Quarta-feira", "Quinta-feira", "Sexta-feira", "Sábado", "Portugais")
End Select
'Set of languages with which we want to indicate the names of the days of the week (whatever their alphabet)
Select Case ChxLangue
Case 1: langue = Array("Lâyenga", "Bïkua-ôko", "Bïkua-ûse", "Bïkua-otâ", "Bïkua-usïö", "Bïkua-okü", "Lâpôso", "Sängö")
Case 2: langue = Array("Dumíniga", "Lunis", "Martis", "Mèrcuris", "Giòvia", "Chenàbura", "Sàbadu", "Sarde")
Case 3: langue = Array("Sunday", "Monanday", "Tysday", "Wadensday", "Fuirsday", "Friday", "Seturday", "Scots")
Case 4: langue = Array("Sontaga", "Mosupalogo", "Labobedi", "Laboraro", "Labone", "Labohlano", "Mokibelo", "Sepedi")
Case 5: langue = Array(ChrW(1053) & ChrW(1077) & ChrW(1076) & ChrW(1077) & ChrW(1114) & ChrW(1072), _
ChrW(1055) & ChrW(1086) & ChrW(1085) & ChrW(1077) & ChrW(1076) & ChrW(1077) & ChrW(1114) & ChrW(1072) & ChrW(1082), _
ChrW(1059) & ChrW(1090) & ChrW(1086) & ChrW(1088) & ChrW(1072) & ChrW(1082), _
ChrW(1057) & ChrW(1088) & ChrW(1077) & ChrW(1076) & ChrW(1072), _
ChrW(1063) & ChrW(1077) & ChrW(1090) & ChrW(1074) & ChrW(1088) & ChrW(1090) & ChrW(1072) & ChrW(1082), _
ChrW(1055) & ChrW(1077) & ChrW(&H442) & ChrW(1072) & ChrW(1082), _
ChrW(1057) & ChrW(1091) & ChrW(1073) & ChrW(1086) & ChrW(1090) & ChrW(1072), "Serbo-Croate")
...
Case 44: langue = Array("Alhadi", "Atinni", "Atalata", "Alarba", "Alamisi", "Alzuma", "Asibiti", "Zarma")
Case 45: langue = Array("Yew" & ChrW(&H15F) & "eme", "Di" & ChrW(&H15F) & "eme", "Sê" & ChrW(&H15F) & "eme", "Çar" & ChrW(&H15F) & "eme", "Pan" & ChrW(&H15F) & "eme", "Îne", ChrW(&H15E) & "eme", "Zazaki")
Case 46: langue = Array("iSonto", "uMombuluko", "uLwesibili", "uLwesithathu", "uLwesine", "uLewishlanu", "uMgqibelo", "Zoulou")
Case 47: langue = Array("Sælldé", "Lúnidé", "Mærturdé", "Mjörkridé", "Hordes", "Ýnirrdé", "Sætnidé", ChrW(&HDE) & "rjótrunn " & ChrW(9775))
End Select
'WARNING! Update the "NbLangues" variable if you add a new language
NbLangues = 47 'number of languages listed in the function
If transcription Then 'the chosen language is in an abstruse alphabet
'WARNING! Each "Case" must bear the same number as that of the language in the esoteric alphabet which is latinized
'Set of languages in abstruse alphabets that are latinized
Select Case ChxLangue
Case 5: latinisation = Array("Nedelja", "Ponedeljak", "Utorak", "Srijeda", ChrW(268) & "etvrtak", "Petak", "Subota", "Serbo-Croate")
Case 18: latinisation = Array("Âk" & ChrW(353) & "anbe", "Du" & ChrW(353) & "anbe", "Se" & ChrW(353) & "anbe", ChrW(268) & "or" & ChrW(353) & "anbe", "Panç" & ChrW(353) & "anbe", "Çum’a", ChrW(352) & "anbe", "Tajik")
Case 21: latinisation = Array("K’irande", "Orshot", "Shinara", "Qaara", "Eara", "P’eraska", "Shot", "Tchétchène")
Case 22: latinisation = Array("It" & ChrW(299) & " senibeti", "It" & ChrW(299) & " senuyi", "It" & ChrW(299) & " selusi", "It" & ChrW(299) & " rebu‘i", "It" & ChrW(299) & " " & ChrW(7717) & "amusi", "It" & ChrW(299) & " ‘arib" & ChrW(299), "It" & ChrW(299) & " k'edami", "Tigrinya")
Case 28: latinisation = Array("Nedilya", "Ponedilok", "Vivtorok", "Sereda", "Chetver", "P'jatnycja", "Subota", "Ukrainien")
Case 43: latinisation = Array("Zuntik", "Montik", "Dinstik", "Mitvokh", "Donershtik", "Fraytik", "Shabes", "Yiddsh")
End Select
On Error Resume Next 'otherwise, oddly enough, it crashes
BlocLangues2 = latinisation(Weekday(fecha) - 1) 'latinized day of the week (Base Option 0). If not -> ""
ElseIf NbItems Then
BlocLangues2 = NbLangues 'total number of languages listed in the function
ElseIf NomLangue = 1 Then
BlocLangues2 = langue(7) 'name of the chosen language
ElseIf NomLangue = 2 Then
BlocLangues2 = LangueRef(Weekday(fecha) - 1) 'day of the week, corresponding to the date "fecha", in an understandable language (Option Base 0)
ElseIf NomLangue = 3 Then
BlocLangues2 = LangueRef(7) 'understandable language name
Else
BlocLangues2 = langue(Weekday(fecha) - 1) 'day of the week, corresponding to the date "fecha", in the chosen language (Base Option 0)
End If
End Function
Paul_Hossler
04-10-2021, 04:43 PM
Why do you rebuild built-in Excel options ?
It all can be done with 0 lines of VBA-code.
Not sure about the 0 lines, but there is a lot of information available using the APIs
For example, the test sub below retrieves the days of the week for several languages. You have to use a userform control since there are the foreign (to us US-ers) and don't show in Msgbox
I have an InitLocale sub that populates these public variables based on the Locale ID (LCID)
Using the locale arrays to format a date or something else is left as a homework assignment
'Public Month, DOW, and Day strings ----------------------------------------------------------------------------
'NOTE -- if 13 month calendar then these are ReDim Preserve to (1 to 13) so ALWAYS use LBound to UBound
'
'Public LocaleMonths() As String 'Array of months in local language
'Public LocaleMonthsAbbr() As String 'Array of month abbrevations in local language
' 'returns the standalone, or nominative, form of the month name
'Public LocaleMonthsGenitive() As String 'Array of genitive months abbrevations in local language (
' 'Genitive names exist because some languages use a different case of nouns to express dates
' '(genitive instead of nominative).
' 'in Polish nominative for January is "styczen" but to express a date 2 January
' 'you need to use genitive "2 stycznia".
'
'Public LocaleDays(1 To 7) As String 'Array of days of week in local language
'Public LocaleDaysAbbr(1 To 7) As String 'Array of days of week abbrevation in local language
'Public LocaleDaysShort(1 To 7) As String 'Array of 2 char days of the week in local language for calendar day titles
'Public LocaleDayOfWeek(1 To 7) As Long 'Array maps WeekDay function (1 to 7) to LocaleDays(x), etc.
' 'LocaleDays(LocaleDayOfWeek(WeekDay(Now)))
'Public LocaleStartingDayOfWeek As VBA.VbDayOfWeek
'Public LocaleStartingWeekOfYear As VBA.VbFirstWeekOfYear
'
'Public LocaleLongDateFormat As String 'dddd, MMMM d, yyyy
'Public LocaleShortDateFormat As String 'M/d/yyyy
Simple sub to display DOW
Option Explicit
Sub test()
Load UserForm1
'user default
Call InitLocale
ShowDOW
'spanish
Call InitLocale("es")
ShowDOW
'german
Call InitLocale("de")
ShowDOW
'arabic
Call InitLocale("ar")
ShowDOW
'russian
Call InitLocale("ru")
ShowDOW
End Sub
Sub ShowDOW()
With UserForm1
.Label1.Caption = LocaleDays(1)
.Label2.Caption = LocaleDays(2)
.Label3.Caption = LocaleDays(3)
.Label4.Caption = LocaleDays(4)
.Label5.Caption = LocaleDays(5)
.Label6.Caption = LocaleDays(6)
.Label7.Caption = LocaleDays(7)
.Show
End With
End Sub
Locale and Language ID's are in a worksheet in the attachment as is LocaleInit()
I like to use (re-use) modules so this is one from my 'toolbox'
'----------------------------------------------------------------------------------------
' sys_Locale - utilities to work with international data
' ver 05 2/4/2021
' fixed typos
' ver 04 11/17/2020
' add Excel uses an (undocumented) escape sequence for "system default"
' This is
' [$-F800] for date, long system default
' [$-F400] for time, system default".
'
' ver 03 9/17/2020
' tweaks to work with CalendarForm better
' ver 02 10/13/2017
' changed names localeInfo and localeDate
' change localeInfo to use LOCALE_NAME_USER_DEFAULT (= "") for User Default location
' ver 01 10/13/2014
' initial
'----------------------------------------------------------------------------------------
Option Explicit
Option Private Module
Private Declare PtrSafe Function GetLocaleInfoEx Lib "kernel32" (ByVal lpLocaleName As LongPtr, ByVal LCType As Long, ByVal lpLCData As LongPtr, ByVal cchData As Long) As Long
'https://docs.microsoft.com/en-us/windows/win32/intl/national-language-support-reference
'---------------------------------------------------------------------------------------- type
Public Const LOCALE_NAME_USER_DEFAULT = vbNullString
Public Const LOCALE_USER_DEFAULT As Long = &H400
'---------------------------------------------------------------------------------------- locale
Public Const LOCALE_SNAME As Long = &H5C 'en-US
'---------------------------------------------------------------------------------------- native
Public Const LOCALE_SNATIVECOUNTRYNAME As Long = &H8 'native name of country = United States
Public Const LOCALE_SNATIVELANGUAGENAME As Long = &H4 'native name of language = English
Public Const LOCALE_SNATIVEDIGITS As Long = &H13 'native digits = 0123456789
Public Const LOCALE_SNATIVECURRNAME As Long = &H1008 'native name of currency = US Dollar
'---------------------------------------------------------------------------------------- language
Public Const LOCALE_SENGLANGUAGE As Long = &H1001 'English name of language
Public Const LOCALE_ILANGUAGE As Long = &H1 '0409
Public Const LOCALE_SLANGUAGE As Long = &H2 'English (United States)
Public Const LOCALE_SABBREVLANGNAME As Long = &H3 'ENU
Public Const LOCALE_SPARENT As Long = &H6D 'en
Public Const LOCALE_SISO639LANGNAME As Long = &H59 'en
Public Const LOCALE_SISO639LANGNAME2 As Long = &H67 'eng
'---------------------------------------------------------------------------------------- country
Public Const LOCALE_SENGCOUNTRY As Long = &H1002 'English name of country
Public Const LOCALE_ICOUNTRY As Long = &H5 '1
Public Const LOCALE_SCOUNTRY As Long = &H6 'United States
Public Const LOCALE_SABBREVCTRYNAME As Long = &H7 'USA
Public Const LOCALE_IDEFAULTLANGUAGE As Long = &H9
Public Const LOCALE_IDEFAULTCOUNTRY As Long = &HA
Public Const LOCALE_IDEFAULTCODEPAGE As Long = &HB
Public Const LOCALE_SISO3166CTRYNAME As Long = &H5A 'US
Public Const LOCALE_SISO3166CTRYNAME2 As Long = &H68 'USA
'---------------------------------------------------------------------------------------- numbers
Public Const LOCALE_SLIST = &HC
Public Const LOCALE_IMEASURE As Long = &HD
Public Const LOCALE_SDECIMAL As Long = &HE
Public Const LOCALE_STHOUSAND As Long = &HF
Public Const LOCALE_SGROUPING As Long = &H10
Public Const LOCALE_IDIGITS As Long = &H11
Public Const LOCALE_ILZERO As Long = &H12
Public Const LOCALE_SINTLSYMBOL As Long = &H15 'intl symbol
Public Const LOCALE_SMONDECIMALSEP As Long = &H16 'decimal separator
Public Const LOCALE_SMONTHOUSANDSEP As Long = &H17 'thousand separator
Public Const LOCALE_SMONGROUPING As Long = &H18 'grouping
Public Const LOCALE_ICENTURY As Long = &H24
Public Const LOCALE_ITLZERO As Long = &H25
Public Const LOCALE_SPOSITIVESIGN As Long = &H50
Public Const LOCALE_SNEGATIVESIGN As Long = &H51
Public Const LOCALE_IPOSSIGNPOSN As Long = &H52 'pos sign position
Public Const LOCALE_INEGSIGNPOSN As Long = &H53 'neg sign position
Public Const LOCALE_INEGATIVEPERCENT As Long = &H74
Public Const LOCALE_IPOSITIVEPERCENT As Long = &H75
Public Const LOCALE_SPERCENT As Long = &H76
Public Const LOCALE_SPERMILLE As Long = &H77
Public Const LOCALE_SPOSINFINITY As Long = &H6A
Public Const LOCALE_SNEGINFINITY As Long = &H6B
Public Const LOCALE_INEGNUMBER As Long = &H1010
'---------------------------------------------------------------------------------------- currency
Public Const LOCALE_IINTLCURRDIGITS As Long = &H1A '# intl digits
Public Const LOCALE_SCURRENCY As Long = &H14 'local currency symbol
Public Const LOCALE_ICURRENCY As Long = &H1B 'pos currency mode
Public Const LOCALE_INEGCURR As Long = &H1C 'neg currency mode
Public Const LOCALE_ICURRDIGITS As Long = &H19 '# local digits
Public Const LOCALE_IPOSSYMPRECEDES As Long = &H54 'mon sym precedes pos amt
Public Const LOCALE_IPOSSEPBYSPACE As Long = &H55 'mon sym sep by space from pos amt
Public Const LOCALE_INEGSYMPRECEDES As Long = &H56 'mon sym precedes neg amt
Public Const LOCALE_INEGSEPBYSPACE As Long = &H57 'mon sym sep by space from neg amt
Public Const LOCALE_SENGCURRNAME As Long = &H1007 'english name of currency
'---------------------------------------------------------------------------------------- formats
Public Const LOCALE_SSHORTDATE As Long = &H1F 'M/d/yyyy
Public Const LOCALE_SLONGDATE As Long = &H20 'dddd, MMMM d, yyyy
Public Const LOCALE_SMONTHDAY As Long = &H78 'MMMM d
Public Const LOCALE_SSHORTTIME As Long = &H79 'h:mm tt
Public Const LOCALE_STIMEFORMAT As Long = &H1003 'h:mm:ss tt
Public Const LOCALE_SYEARMONTH As Long = &H1006 'MMMM yyyy
'---------------------------------------------------------------------------------------- time
Public Const LOCALE_S1159 As Long = &H28 'AM
Public Const LOCALE_S2359 As Long = &H29 'PM
Public Const LOCALE_STIME As Long = &H1E 'time seperator ":"
Public Const LOCALE_ITIME As Long = &H23
Public Const LOCALE_SDURATION As Long = &H5D 'h:mm:ss
'---------------------------------------------------------------------------------------- dates
Public Const LOCALE_SDATE As Long = &H1D 'date seperator "/"
Public Const LOCALE_IDATE As Long = &H21
Public Const LOCALE_ILDATE As Long = &H22
Public Const LOCALE_IDAYLZERO As Long = &H26
Public Const LOCALE_IMONLZERO As Long = &H27
Public Const LOCALE_IFIRSTDAYOFWEEK As Long = &H100C
'0 LOCALE_SDAYNAME1 (Monday)
'1 LOCALE_SDAYNAME2 (Tuesday)
'2 LOCALE_SDAYNAME3 (Wednesday)
'3 LOCALE_SDAYNAME4 (Thursday)
'4 LOCALE_SDAYNAME5 (Friday)
'5 LOCALE_SDAYNAME6 (Saturday)
'6 LOCALE_SDAYNAME7 (Sunday)
Public Const LOCALE_IFIRSTWEEKOFYEAR As Long = &H100D
'vbUseSystem as VbFirstWeekOfYear
' vbFirstFourDays, vbFirstFullWeek, vbFirstJan1
'---------------------------------------------------------------------------------------- days
Public Const LOCALE_SDAYNAME1 As Long = &H2A 'long name for Monday
Public Const LOCALE_SDAYNAME2 As Long = &H2B 'long name for Tuesday
Public Const LOCALE_SDAYNAME3 As Long = &H2C 'long name for Wednesday
Public Const LOCALE_SDAYNAME4 As Long = &H2D 'long name for Thursday
Public Const LOCALE_SDAYNAME5 As Long = &H2E 'long name for Friday
Public Const LOCALE_SDAYNAME6 As Long = &H2F 'long name for Saturday
Public Const LOCALE_SDAYNAME7 As Long = &H30 'long name for Sunday
Public Const LOCALE_SABBREVDAYNAME1 As Long = &H31 'short name for Mon
Public Const LOCALE_SABBREVDAYNAME2 As Long = &H32 'short name for Tue
Public Const LOCALE_SABBREVDAYNAME3 As Long = &H33 'short name for Wed
Public Const LOCALE_SABBREVDAYNAME4 As Long = &H34 'short name for Thu
Public Const LOCALE_SABBREVDAYNAME5 As Long = &H35 'short name for Fri
Public Const LOCALE_SABBREVDAYNAME6 As Long = &H36 'short name for Sat
Public Const LOCALE_SABBREVDAYNAME7 As Long = &H37 'short name for Sun
Public Const LOCALE_SSHORTESTDAYNAME1 As Long = &H60 '2 char version Mo
Public Const LOCALE_SSHORTESTDAYNAME2 As Long = &H61
Public Const LOCALE_SSHORTESTDAYNAME3 As Long = &H62
Public Const LOCALE_SSHORTESTDAYNAME4 As Long = &H63
Public Const LOCALE_SSHORTESTDAYNAME5 As Long = &H64
Public Const LOCALE_SSHORTESTDAYNAME6 As Long = &H65
Public Const LOCALE_SSHORTESTDAYNAME7 As Long = &H66
'---------------------------------------------------------------------------------------- months
Public Const LOCALE_SMONTHNAME1 As Long = &H38 'January
Public Const LOCALE_SMONTHNAME2 As Long = &H39
Public Const LOCALE_SMONTHNAME3 As Long = &H3A
Public Const LOCALE_SMONTHNAME4 As Long = &H3B
Public Const LOCALE_SMONTHNAME5 As Long = &H3C
Public Const LOCALE_SMONTHNAME6 As Long = &H3D
Public Const LOCALE_SMONTHNAME7 As Long = &H3E
Public Const LOCALE_SMONTHNAME8 As Long = &H3F
Public Const LOCALE_SMONTHNAME9 As Long = &H40
Public Const LOCALE_SMONTHNAME10 As Long = &H41
Public Const LOCALE_SMONTHNAME11 As Long = &H42
Public Const LOCALE_SMONTHNAME12 As Long = &H43 'December
Public Const LOCALE_SABBREVMONTHNAME1 As Long = &H44 'Jan
Public Const LOCALE_SABBREVMONTHNAME2 As Long = &H45
Public Const LOCALE_SABBREVMONTHNAME3 As Long = &H46
Public Const LOCALE_SABBREVMONTHNAME4 As Long = &H47
Public Const LOCALE_SABBREVMONTHNAME5 As Long = &H48
Public Const LOCALE_SABBREVMONTHNAME6 As Long = &H49
Public Const LOCALE_SABBREVMONTHNAME7 As Long = &H4A
Public Const LOCALE_SABBREVMONTHNAME8 As Long = &H4B
Public Const LOCALE_SABBREVMONTHNAME9 As Long = &H4C
Public Const LOCALE_SABBREVMONTHNAME10 As Long = &H4D
Public Const LOCALE_SABBREVMONTHNAME11 As Long = &H4E
Public Const LOCALE_SABBREVMONTHNAME12 As Long = &H4F 'Dec
Public Const LOCALE_SMONTHNAME13 As Long = &H100E
Public Const LOCALE_SABBREVMONTHNAME13 As Long = &H100F
'------------------------------------------------------------------------------------misc
Public Const LOCALE_FONTSIGNATURE As Long = &H58
Public Const LOCALE_IGEOID As Long = &H5B '244
Public Const LOCALE_SKEYBOARDSTOINSTALL = &H5E
Public Const LOCALE_SNAN As Long = &H69
Public Const LOCALE_SSCRIPTS As Long = &H6C 'Latn;
Public Const LOCALE_SCONSOLEFALLBACKNAME As Long = &H6E
Public Const LOCALE_IREADINGLAYOUT As Long = &H70
Public Const LOCALE_INEUTRAL As Long = &H71
Public Const LOCALE_SOPENTYPELANGUAGETAG As Long = &H7A
Public Const LOCALE_SSORTLOCALE As Long = &H7B
Public Const LOCALE_IDEFAULTANSICODEPAGE As Long = &H1004
Public Const LOCALE_ITIMEMARKPOSN As Long = &H1005
Public Const LOCALE_ICALENDARTYPE As Long = &H1009
Public Const LOCALE_IPAPERSIZE As Long = &H100A
Public Const LOCALE_IOPTIONALCALENDAR As Long = &H100B
Public Const LOCALE_IDEFAULTMACCODEPAGE As Long = &H1011
Public Const LOCALE_IDEFAULTEBCDICCODEPAGE As Long = &H1012
Public Const LOCALE_SSORTNAME As Long = &H1013 'Default
Public Const LOCALE_IDIGITSUBSTITUTION As Long = &H1014
'Public Month, DOW, and Day strings ----------------------------------------------------------------------------
'NOTE -- if 13 month calendar then these are ReDim Preserve to (1 to 13) so ALWAYS use LBound to UBound
Public LocaleMonths() As String 'Array of months in local language
Public LocaleMonthsAbbr() As String 'Array of month abbrevations in local language
'returns the standalone, or nominative, form of the month name
Public LocaleMonthsGenitive() As String 'Array of genitive months abbrevations in local language (
'Genitive names exist because some languages use a different case of nouns to express dates
'(genitive instead of nominative).
'in Polish nominative for January is "styczen" but to express a date 2 January
'you need to use genitive "2 stycznia".
Public LocaleDays(1 To 7) As String 'Array of days of week in local language
Public LocaleDaysAbbr(1 To 7) As String 'Array of days of week abbrevation in local language
Public LocaleDaysShort(1 To 7) As String 'Array of 2 char days of the week in local language for calendar day titles
Public LocaleDayOfWeek(1 To 7) As Long 'Array maps WeekDay function (1 to 7) to LocaleDays(x), etc.
'LocaleDays(LocaleDayOfWeek(WeekDay(Now)))
Public LocaleStartingDayOfWeek As VBA.VbDayOfWeek
Public LocaleStartingWeekOfYear As VBA.VbFirstWeekOfYear
Public LocaleLongDateFormat As String 'dddd, MMMM d, yyyy
Public LocaleShortDateFormat As String 'M/d/yyyy
Sub InitLocale(Optional LCID As String = LOCALE_NAME_USER_DEFAULT)
Dim i As Long
Dim aryFull(1 To 14) As String, aryAbbr(1 To 14) As String, aryShort(1 To 14) As String
Dim s As String
'The first day of the calendar week.
'0 = vbMonday, ... , 6 = vbSunday
LocaleStartingDayOfWeek = localeInfo(LOCALE_IFIRSTDAYOFWEEK, LCID) + 2
If LocaleStartingDayOfWeek > vbSaturday Then LocaleStartingDayOfWeek = LocaleStartingDayOfWeek - vbSaturday
'Starting week number = 1 of year
LocaleStartingWeekOfYear = localeInfo(LOCALE_IFIRSTWEEKOFYEAR, LCID)
'fill months arrays
If Len(localeInfo(LOCALE_SMONTHNAME13, LCID)) > 0 Then ' 13 month calendr
ReDim LocaleMonths(1 To 13)
ReDim LocaleMonthsAbbr(1 To 13)
ReDim LocaleMonthsGenitive(1 To 13)
LocaleMonths(13) = localeInfo(LOCALE_SMONTHNAME13, LCID)
LocaleMonthsAbbr(13) = localeInfo(LOCALE_SABBREVMONTHNAME13, LCID)
s = Format(DateSerial(Year(Now), 13, 1), "ddMMMM")
LocaleMonthsGenitive(13) = Right(s, Len(s) - 2)
Else ' 12 month calendar
ReDim LocaleMonths(1 To 12)
ReDim LocaleMonthsAbbr(1 To 12)
ReDim LocaleMonthsGenitive(1 To 12)
End If
For i = 1 To 12 'January, February ... -- Note (13) set abouve if 13 month calendar
LocaleMonths(i) = localeInfo(LOCALE_SMONTHNAME1 + i - 1, LCID)
LocaleMonthsAbbr(i) = localeInfo(LOCALE_SABBREVMONTHNAME1 + i - 1, LCID)
s = Format(DateSerial(Year(Now), i, 1), "ddMMMM")
LocaleMonthsGenitive(i) = Right(s, Len(s) - 2)
Next i
'fill day arrays
For i = 1 To 7
'1=Monday 2=Tuesday 3=Wednesday .....
aryFull(i) = localeInfo(LOCALE_SDAYNAME1 + i - 1, LCID)
aryFull(7 + i) = aryFull(i)
'1=Mon 2=Tue 3=Wed .....
aryAbbr(i) = localeInfo(LOCALE_SABBREVDAYNAME1 + i - 1, LCID)
aryAbbr(7 + i) = aryAbbr(i)
'1=Mo 2=Tu 3=We 4=Th 5=Fr 6=Sa 7=Su, 8=Mo, etc.
aryShort(i) = localeInfo(LOCALE_SSHORTESTDAYNAME1 + i - 1, LCID)
aryShort(7 + i) = aryShort(i)
Next i
'fill day of week arrays
Select Case LocaleStartingDayOfWeek
Case vbSunday ' 1
For i = vbSunday To vbSaturday
LocaleDays(i) = aryFull(6 + i)
LocaleDaysAbbr(i) = aryAbbr(6 + i)
LocaleDaysShort(i) = aryShort(6 + i)
LocaleDayOfWeek(i) = i
Next i
Case vbMonday To vbSaturday ' 2 to 7
For i = vbSunday To vbSaturday
LocaleDays(i) = aryFull(LocaleStartingDayOfWeek + i - 2)
LocaleDaysAbbr(i) = aryAbbr(LocaleStartingDayOfWeek + i - 2)
LocaleDaysShort(i) = aryShort(LocaleStartingDayOfWeek + i - 2)
Next i
For i = vbSunday To vbSaturday
LocaleDayOfWeek(i) = LocaleStartingDayOfWeek + i - 3
Next i
If LocaleDayOfWeek(vbSunday) < vbSunday Then LocaleDayOfWeek(vbSunday) = LocaleDayOfWeek(vbSunday) + vbSaturday
End Select
'Excel uses an (undocumented) escape sequence for "system default"
'This is
' [$-F800] for date, long system default
' [$-F400] for time, system default".
LocaleLongDateFormat = "[$-F800]" & localeInfo(LOCALE_SLONGDATE, LCID)
LocaleShortDateFormat = localeInfo(LOCALE_SSHORTDATE, LCID)
End Sub
'http://www.science.co.il/language/locale-codes.asp
Function localeInfo(ByVal lInfo As Long, Optional LCID As String = LOCALE_NAME_USER_DEFAULT) As String
'http://msdn.microsoft.com/en-us/library/ee825488(v=cs.20).aspx
Dim sLocaleName As String
Dim sRetBuffer As String
Dim nCharsRet As Long
If Len(LCID) > 0 Then
sLocaleName = LCID & Chr$(0)
End If
nCharsRet = GetLocaleInfoEx(StrPtr(sLocaleName), lInfo, StrPtr(sRetBuffer), 0)
If nCharsRet > 0 Then
sRetBuffer = String(nCharsRet, Chr$(0))
nCharsRet = GetLocaleInfoEx(StrPtr(sLocaleName), lInfo, StrPtr(sRetBuffer), nCharsRet)
localeInfo = Left(sRetBuffer, Len(sRetBuffer) - 1) 'Added GKM - printed result was displaying and odd AscW(0) character
End If
End Function
Paul_Hossler
04-13-2021, 10:04 AM
I found it very difficult to follow your code, partly due to variables being in French, and partly due to the structure
I would make it much more modular and load arrays with the data needed. The attachment has some suggestions, and once the arrays are filled, it's a only a matter of looking up the specific language values in the array
Time to load the arrays is imperceptable
Edit - I supposed uploading the correct file would help :doh::think::think:
Option Explicit
Const numLanguages As Long = 198
Public aryBaseLanguages(1 To 4) As Variant
Public aryBaseLanguagesNames(1 To 4) As Variant
Public aryLanguagesDays(1 To numLanguages) As Variant
Public aryLanguages(1 To numLanguages) As String
Public aryLanguageLatin(1 To numLanguages) As Variant
Sub Load()
Dim i As Long
For i = LBound(aryBaseLanguages) To UBound(aryBaseLanguages)
aryBaseLanguages(i) = GetBaseLanguage(i)
aryBaseLanguagesNames(i) = aryBaseLanguages(i)(7)
Next i
For i = 1 To numLanguages
aryLanguagesDays(i) = GetLanguage(i) ' 0-6 days, 7 = language
aryLanguages(i) = aryLanguagesDays(i)(7)
aryLanguageLatin(i) = GetLatinization(i)
Next i
'sample use
i = 0
On Error Resume Next
i = Application.WorksheetFunction.Match("Géorgien", aryLanguages, 0)
On Error GoTo 0
If i > 0 Then MsgBox i
End Sub
'Basic languages (understandable)
Function GetBaseLanguage(n As Long) As Variant
Select Case n
Case 1: GetBaseLanguage = Array("Dimanche", "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Français")
Case 2: GetBaseLanguage = Array("Domingo", "Lunes", "Martes", "Miércoles", "Jueves", "Viernes", "Sábado", "Espagnol")
Case 3: GetBaseLanguage = Array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Anglais")
Case 4: GetBaseLanguage = Array("Domingo", "Segunda-feira", "Terça-feira", "Quarta-feira", "Quinta-feira", "Sexta-feira", "Sábado", "Portugais")
End Select
End Function
Function GetLanguage(n As Long) As Variant
Select Case n
Case 1 To 50
GetLanguage = GetLanguage50(n)
Case 51 To 100
GetLanguage = GetLanguage100(n)
Case 101 To 150
GetLanguage = GetLanguage150(n)
Case 151 To 200
GetLanguage = GetLanguage200(n)
End Select
End Function
Function GetLanguage50(n As Long) As Variant
Select Case n
Case 1: GetLanguage50 = Array(ChrW(1040) & ChrW(1084) & ChrW(1213) & ChrW(1100) & ChrW(1231) & ChrW(1096), _
ChrW(1040) & ChrW(1096) & ChrW(1241) & ChrW(1072) & ChrW(1093) & ChrW(1100), _
ChrW(1040) & ChrW(1193) & ChrW(1072) & ChrW(1096), _
ChrW(1040) & ChrW(1093) & ChrW(1072) & ChrW(1096), _
ChrW(1040) & ChrW(1191) & ChrW(1096) & ChrW(1100) & ChrW(1072) & ChrW(1096), _
ChrW(1040) & ChrW(1093) & ChrW(1241) & ChrW(1072) & ChrW(1096), _
ChrW(1040) & ChrW(1089) & ChrW(1072) & ChrW(1073) & ChrW(1096), "Abkhaze")
Case 2: GetLanguage50 = Array("Sonndag", "Maandag", "Dinsdag", "Woensdag", "Donderdag", "Vrydag", "Saterdag", "Afrikaans")
Case 3: GetLanguage50 = Array("Nihtahollo", "Nihta a" & ChrW(620) & ChrW(620) & "ámmòona", "Nihta atòkla", "Nihta atótchìina", "Nihta istóstàaka", "Nihta istá" & ChrW(620) & ChrW(620) & "àapi", "Nihtahollosi", "Alabama")
Case 4: GetLanguage50 = Array("E diel", "E hënë", "E martë", "E mërkurë", "E enjte", "E premte", "E shtunë", "Albanais")
Case 5: GetLanguage50 = Array("Sonntag", "Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag", "Allemand")
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.