Printable View
Hello,
I wrote a function that returns the names of the days of the week in different languages ("NomJourSemaineTrip" in the attachment).
The function works well up to 181 languages. Beyond that (from 182 languages), I get an error message: "Compile Error: Procedure too large". I really don't understand why. How to solve this problem?
First: I notice that you declare ChxLangue As Byte. Since the only reason to use Bytes is to conserve memory usage and since only one value of ChxLangue is used at a time. I would declare it as an Integer. (Bytes are limited to only 254 positive integers)
As to that Too Long Procedure, I would break Select CaseChxLangue into several smaller Functions
Code:Select Case ChxLangue
Case 1 to 50: LangueRef = ChxLangue1_50(ChxLangue)
Case 51 to 100: LangueRef = ChxLangue51_100(ChxLangue)
Case Etc
Case Esle: LangueRef = "Unknown"
End Select
Code:Function ChxLangue1_50(ChxLangue as Long) As Variant
Select Case ChxLangue
Case 1: Langue = XLangue
Etc:
Case 50: Langue = YLangue
End Select
End Function
Code:Function XLangue() As Variant
XLangue = 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")
End Function
Since the various XLangue and YLangue Functions don't Have to be in the same module as NomJourSemaineTrip, think about separating them into Modules named after Language Families or even Continents Anything that makes adding, editing and maintaining them easier. I would keep the "ChxLangue1_50," "ChxLangue51_100" Etc Functions in the same module as NomJourSemaineTripCode:Function YLangue() As Variant
YLangue = Array("Sennedei", "Monnendei", "Tirsdei", "Winsdei", "Türsdei", "Frideisennin", "Sennin", "Frisien (Nord)")
End Function
BTW, I would use real descriptive names for those Functions, like "FrenchWeekDays," "LangueEnglish," "TagalogLangue," etc. Instead of using "Magic Numbers" to reference languages, I would at least use an Enum.
My guess is that the Procedure is too large and has exceeded some internal limit
As a possible work-around you might take
and split it by LangueBase and call call 2 different functions with 1 to 100 in one, and 101 to 182 in the otherCode:Function NomJourSemaineTrip$(Optional fecha As Date, Optional ChxLangue As Byte, Optional NomLangue As Byte, Optional NbItems As Boolean = False, Optional transcription As Boolean = False, Optional LangueBase As Byte)
Code:Function NomJourSemaineTrip$(Optional fecha As Date, Optional ChxLangue As Byte, Optional NomLangue As Byte, Optional NbItems As Boolean = False, Optional transcription As Boolean = False, Optional LangueBase As Byte)
If LangueBase <= 100 Then
NomJourSemaineTrip100 (.....)
Else
NomJourSemaineTrip101 (.....)
End If
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:
Code: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
Code: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
Code: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
Why do you rebuild built-in Excel options ?
It all can be done with 0 lines of VBA-code.
Quote:
Originally Posted by snb
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
Code:'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
Locale and Language ID's are in a worksheet in the attachment as is LocaleInit()Code: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
I like to use (re-use) modules so this is one from my 'toolbox'
Code:'----------------------------------------------------------------------------------------
' 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
WOW! That is a very well done Project. Since it is in French, I am unable to fully understand all the code. All I can offer to help troubleshooting is to insure that the Functions are indeed identical, and... I do notice that you have several Variables Defined as Byte Types. This is only a good thing if you have many thousands of Numerical Variables. If you have any Quantities larger than 255, you will run into Errors. Due to this, and the fact that one almost never uses many thousands of any variables in VBA, I almost always use Long or Double Types for numerical variables. I only use Byte Types when they are the native Type of a Function or Method.
Since all Language references in your code use an Index number and the only way to identify the language is to look at the final element of each array, it will be nearly impossible to expand this to translate Years, Months, and Dates to other formats/languages. Personally I would use Functions named for the language to be translated.
Example, in Module (modWeekdays)
I know that is a lot of Cut and Paste (Or use UltraEdit and a short Macro.) Since the Compiled size of a Module, or Class, is 64K, I doubt that even putting all Functions into one module will ever reach that limit. Since the physical order of the Functions doesn't matter, it makes it very easy to add languages.Code:Function Français(): Francais = Array("Dimanche", "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Français"): End Function
Function Serbo_Croate(): Serbo-Croate = = Array("Nedelja", "Ponedeljak", "Utorak", "Srijeda", ChrW(268) & "etvrtak", "Petak", "Subota", "Serbo-Croate"): End Function
Function esoteric_Serbo_Croate()
esoteric_Serbo_Croate = 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") :End Function
Since different Class Modules can use the same Function names, consider using Class Modules: clsLatinWeekDays, clsEsoWeekDays, clsLatinMonths, clsEsoMonths, clsEsoNumbers, and even clsEsoYears
While the use of Class Modules means you would need to set Objects
Your Form Code could basically beCode:Dim WeekDays As Object, EsoWeekDays As object 'Etc.
Set WeekDays = clsLatinWeekDays
Set EsoDays = clsEsoWeekdays
'Etc.
Code:Me.TextBoxLatinDays = WeekDays.Serbo_Croate
Me.TextBoxEsoDays = EsoDays.Serbo_Croate
And Adding Moonths, Dates and years is a simple project
Just count the amount of VBA_code.
You might have to adapt the formulae: e.g. "yyyy" instead of "jjjj". (according to your international settings in Windows).
@Magic_Doctor
What is the purpose of the project?
Setting the formats to use the computer's locale and the WS and VBA functions lets Windows do all the heavy lifting.
Has the advantage that if workbook is used in a different region the formulas and display are automatically updated
Quote:
FormatDateTime(Date, [ NamedFormat ])
vbGeneralDate 0 Display a date and/or time. If there is a date part, display it as a short date. If there is a time part, display it as a long time. If present, both parts are displayed. vbLongDate 1 Display a date by using the long date format specified in your computer's regional settings. vbShortDate 2 Display a date by using the short date format specified in your computer's regional settings. vbLongTime 3 Display a time by using the time format specified in your computer's regional settings. vbShortTime 4 Display a time by using the 24-hour format (hh:mm).
Excellent question. should have been asked earlier.Quote:
What is the purpose of the project?
I am definitely saving Pauls Module in Personal.xlsm. Thanks Paul.
@Magic_Doctor
Follow on to letting Windows do the work and just changing Regional Settings and using system defaults
I changed my regional settings 4 or 5 times and ran the same sub using the Windows changed defaults
@snb
I liked your workbook, but I think some of your long date formats are non-standard, e.g. Spanish, compared to what Windows thinks
Attachment 28290
@SamT - I bumped my ver 05 to ver 06 to expose English versions of the country and language. Easily modded to expose the local representation of the language and country
I also turned the module into a class awhile ago (got bored and felt like experimenting) with properties and stuff. Didn't see any reason to keep it updated, since there's only one locale (typically) on a computer
Code:Sub M_snb_weekdagen()
MsgBox Join([transpose(text(row(2:8),"[$-407]dddd"))], vbLf), , "Deutschland"
End Sub
Code:Sub M_snb_weekdagen()
MsgBox Join([transpose(text(row(2:8),"[$-40A]dddd"))], vbLf), , "Espagna"
End Sub
Hello. Thank you for your answers.
The goal of the subject is very simple: to carry out a function which returns only the name of the day of the week in a language chosen in this same function. In short, everything is in the function:
- the list of days of the week in different languages, whatever their alphabet;
- the list of transcribed languages (Latinized) when the chosen language is in an esoteric alphabet;
- the list of days of the week in understandable reference languages to have the names of the days of the week translated into other languages.
In a ComboBox of a form, all the languages listed in the function are listed. You choose a language from the list and in an individual cell appears the name of the day of the week in the chosen language. If the chosen language is in an incomprehensible alphabet (Russian or Armenian for example) and that in the function there is its Latinized transcription, then appears in another cell this same Latinized transcription, which helps singularly to try to pronounce the name of the day of the week. Indeed, when you do not know Russian or Hebrew, good luck deciphering! Finally, if desired, we can display, in a separate cell, the translation of the day of the week in a reference language (chosen in a ComboBox of the form) that we understand.
The function initially worked very well (in all cases) as long as you did not exceed 184 languages (which is already a lot!). Beyond that it no longer worked. So I had to split the function into 2 blocks, which wasn't very difficult. This allowed me to expand the list of languages without any problem. Everything is going perfectly well, except in one situation that I explain:
If I choose Armenian (Arménien in French), for example, this language is in the first function and it has its own completely incomprehensible alphabet. The name of the day of the week in Armenian appears, and in the cell just below its Latinized transcription. Everything is going very well.
Now we choose Chechen (Tchétchène in French), which is a language in the Cyrillic alphabet, but which this time is in the second function. The name of the day of the week in Chechen appears well; however, its Latinized transcription does not appear. And there I wonder why.
I made some minor changes in the ComboBox macro which lists the different languages.
SamT says: ”Since it is in French, I am unable to fully understand all the code.” In my last post (# 4), which obviously has not been read, in the attachment you will notice that I took care to translate all explanations (REM) into English. Everything else is written in VBA.
I wrote this feature just for fun and aesthetics, and to avoid having to put a language database on a separate sheet. As for APIs, sorry, too complicated for me ...
In conclusion, this function works very well, except for one detail which, I think, no longer depends directly on the function.
In my last post (# 12), which obviously has not been read,
1. I like fun project alsoQuote:
Originally Posted by Magic_Doctor
2. I didn't see the combobox or anyway to select a different language in post #13
3. A textbox on a userform has better text rendering capabilities than the worksheet cells
BS. I just didn't download your .26MB file again. Some of us don't have broadband internet.Quote:
SamT says: ”Since it is in French, I am unable to fully understand all the code.” In my last post (# 4), which obviously has not been read,
Bye bye, good luck, have a nice life.
Hello Paul_Hossler
To access the ComboBox, all you have to do is click on the cell with a smiley face, then the USF with the 2 ComboBoxes appears.
I made some necessary modifications for the SpinButton.
What is curious is that if one chooses the Tigrynia language, which is found in the second function, its Latinized transcription appears. I realized that in the second function it occupies position 23. However, in the first function there is a Latinized language which occupies the same position: Bulgarian. There is a kind of interference between these two functions ...
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:
Code: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")
Hello,
Now it works!
The function, which started out as a single piece, worked very well in any case, as long as you did not exceed 184 languages (which is already a lot!). Beyond that it didn't work strangely anymore. So I had to split the function into 3 parts (2 parts with a maximum of 150 languages and a part that manages everything), which was not very difficult (the difficulty, or rather the puzzle, was elsewhere…). This allowed me to expand the list of languages without any problem.
The project was, after all, simple: to create a function which returns only the name of the day of the week in a language chosen in this same function. All the data is in the function (there is nothing on a sheet - hidden or not - of the workbook):
- the list of days of the week in different languages, whatever their alphabet;
- the list of transcribed languages (latinized) when the chosen language is in an esoteric alphabet;
- the list of the days of the week in understandable reference languages to have the translation of the names of the days of the week in the other languages completely incomprehensible most of the time.
In a ComboBox of the form are listed all the languages listed in the function (in fact, the 2 functions that contain them). You choose a language from the list, and in an individual cell (under that of the date) the name of the day of the week in the chosen language appears. If the chosen language is in an incomprehensible alphabet (Russian or Armenian for example) and that in the function there is its Latinized transcription, then appears in a cell, just below the one with the name of the incomprehensible day of the week, this same latinized transcription; which is particularly helpful in trying to decipher and pronounce (as much as possible…) the name of the day of the week. Indeed, when you do not know Russian, Korean or Hebrew, good luck deciphering! Finally, if desired, we can display, in a separate cell, the translation of the day of the week in a reference language (chosen in a dedicated ComboBox of the form) that we understand.
Note that wherever you can click (obviously to trigger something) the RollOver symbol appears (hand with an outstretched finger).
The password is "zaza".
Mr SamT, thanks to your invaluable encouragement, you energized me, and now I can say "la vie est belle !"
:clap:
:beerchug: