Consulting

Results 1 to 20 of 20

Thread: A function that crashes: Compile Error: Procedure too large

  1. #1

    A function that crashes: Compile Error: Procedure too large

    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?
    Attached Files Attached Files

  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    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
    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
    Function ChxLangue1_50(ChxLangue as Long) As Variant
    Select Case ChxLangue
       Case 1: Langue = XLangue
       Etc:
       Case 50: Langue = YLangue
    End Select
    End Function
    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
    Function YLangue() As Variant
       YLangue  = Array("Sennedei", "Monnendei", "Tirsdei", "Winsdei", "Türsdei", "Frideisennin", "Sennin", "Frisien (Nord)")
    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 NomJourSemaineTrip

    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.
    Last edited by SamT; 03-30-2021 at 07:07 AM.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  3. #3
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    My guess is that the Procedure is too large and has exceeded some internal limit

    As a possible work-around you might take

    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)
    and split it by LangueBase and call call 2 different functions with 1 to 100 in one, and 101 to 182 in the other

    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


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

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

  4. #4
    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
    Attached Files Attached Files

  5. #5
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    Why do you rebuild built-in Excel options ?
    It all can be done with 0 lines of VBA-code.

  6. #6
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Quote Originally Posted by snb View Post
    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
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


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

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

  7. #7
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    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)
    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
    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.


    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
    Dim WeekDays As Object, EsoWeekDays As object 'Etc.
    Set WeekDays = clsLatinWeekDays
    Set EsoDays = clsEsoWeekdays
    'Etc.
    Your Form Code could basically be
    Me.TextBoxLatinDays = WeekDays.Serbo_Croate
    Me.TextBoxEsoDays = EsoDays.Serbo_Croate

    And Adding Moonths, Dates and years is a simple project
    Last edited by SamT; 04-10-2021 at 07:20 PM.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  8. #8
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    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).
    Attached Files Attached Files
    Last edited by snb; 04-11-2021 at 04:48 AM.

  9. #9
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    @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

    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).
    ---------------------------------------------------------------------------------------------------------------------

    Paul


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

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

  10. #10
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    What is the purpose of the project?
    Excellent question. should have been asked earlier.

    I am definitely saving Pauls Module in Personal.xlsm. Thanks Paul.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  11. #11
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    @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

    Capture.JPG


    @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
    Attached Images Attached Images
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


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

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

  12. #12
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    Sub M_snb_weekdagen()
       MsgBox Join([transpose(text(row(2:8),"[$-407]dddd"))], vbLf), , "Deutschland"
    End Sub
    Sub M_snb_weekdagen()
       MsgBox Join([transpose(text(row(2:8),"[$-40A]dddd"))], vbLf), , "Espagna"
    End Sub

  13. #13
    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.
    Attached Files Attached Files
    Last edited by Magic_Doctor; 04-12-2021 at 11:21 AM.

  14. #14
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    In my last post (# 12), which obviously has not been read,

  15. #15
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Quote Originally Posted by Magic_Doctor View Post
    Hello. Thank you for your answers.

    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.
    1. I like fun project also

    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


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

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

  16. #16
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    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,
    BS. I just didn't download your .26MB file again. Some of us don't have broadband internet.

    Bye bye, good luck, have a nice life.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  17. #17
    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 ...
    Attached Files Attached Files

  18. #18
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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


    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")
    Attached Files Attached Files
    Last edited by Paul_Hossler; 04-13-2021 at 12:44 PM.
    ---------------------------------------------------------------------------------------------------------------------

    Paul


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

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

  19. #19
    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 !"
    Attached Files Attached Files
    Last edited by Magic_Doctor; 04-18-2021 at 07:59 AM.

  20. #20
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location


    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

Posting Permissions

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