Excel VBA: Analyser la date en anglais à partir de n'importe quelle région du système d'exploitation/locale

Question

J'ai une feuille de calcul avec un sélecteur de date. Jour, mois et année est sélectionné dans des cellules distinctes, comme suit:

J'ai un code qui prend la date sélectionnée, puis vérifie si elle est une date réelle (par exemple pas 31 Février), puis vérifie si elle est "supérieure ou égale à" une date prédéfinie dans la cellule A1. Le format de la date prédéfinie dans A1 n'a pas d'importance, tant qu'il est au format date.

La fonction fonctionne très bien jusqu'à ce que je change ma région de système d'exploitation à, par exemple, l'Espagne. Parce que très simplement, CDate (blah) peut analyser "1 Janvier 2016" quand il est dans la région UK/USA, mais en Espagne, il s'attend à voir Enero, febrero, marzo, abril, etc, au lieu de Janvier, Février, etc . Ceci est le (Windows) J'utilise la mise à émuler d'autres régions:

Et ceci est un extrait de mon code:

Sub getDate() 
    'pick up date: 
    theDay = Cells(13, 9).Value 
    theMonth = Cells(13, 10).Value 
    theYear = Cells(13, 11).Value 

    theCurrentDate = theDay & " " & theMonth & " " & theYear 

    'highlight bad date: 
    If Not IsDate(theCurrentDate) Then 
     Cells(13, 9).Interior.ColorIndex = 38 
     Exit Sub 
    End If 

    If CDate(theCurrentDate) >= CDate(Cells(1, 1)) Then 
     'do some stuff 
    End If 
End Sub 

la 'mettre en relief mauvaise date' étape est où le code glit dans un paramètre de région/langue non anglais ... il mettra en surbrillance la cellule de jour. Je me suis dit que c'était une bonne façon de repérer les mauvaises dates comme le 30 février, en gardant à l'esprit que les trois cellules sont des données validées avec des listes.

Il est important que la date soit sélectionnée plutôt que saisie, et j'aimerais maintenir le format visuel de DD-Month-YYYY, pour transcender les cultures (lire: forcer les utilisateurs à se conformer à un format unique).

J'ai essayé de trouver comment le dire pour prétendre que les paramètres régionaux du programme sont le Royaume-Uni, pour le code ... ou pour lui dire que la date à laquelle il est détecté est en anglais ... Je peux t le comprendre, tout conseil est apprécié. Je vous remercie.

---

EDIT1: J'ai trouvé une solution de contournement pour ce problème. Cela fonctionne en convertissant le nom du mois en un nombre, puis en utilisant la fonction DateSerial pour le transformer en ... une date de série. Le problème avec ceci est, si vous lui donnez une date du 31 avril (avril a 30 jours), alors la date de conversion en série aura comme conséquence le 1er mai. J'ai donc dû faire une routine qui vérifie manuellement que c'est une date légitime (y compris les années bissextiles) ... Voici le nouveau code, encore simplifié même si j'ai inclus la gestion des erreurs pour le rendre plus complet):

Sub getDate() 
    theErr = 0 
    'pick up date: 
    theDay = Cells(13, 9).Value 
    theMonth = Cells(13, 10).Value 
    theYear = Cells(13, 11).Value 

    'Convert month name to number: 
    If theMonth = "January" Then 
     theMonth = 1 
    ElseIf theMonth = "February" Then 
     theMonth = 2 
    ElseIf theMonth = "March" Then 
     theMonth = 3 
    ElseIf theMonth = "April" Then 
     theMonth = 4 
    ElseIf theMonth = "May" Then 
     theMonth = 5 
    ElseIf theMonth = "June" Then 
     theMonth = 6 
    ElseIf theMonth = "July" Then 
     theMonth = 7 
    ElseIf theMonth = "August" Then 
     theMonth = 8 
    ElseIf theMonth = "September" Then 
     theMonth = 9 
    ElseIf theMonth = "October" Then 
     theMonth = 10 
    ElseIf theMonth = "November" Then 
     theMonth = 11 
    ElseIf theMonth = "December" Then 
     theMonth = 12 
    End If 

    'Check manually for bad dates: 
    If InStr("2/4/6/9/11", CStr(theMonth)) Then 'a month with 30 or fewer days: 
     If theMonth <> 1 Then 'January ("1") is found in 11, but January is OK, it has 31 days... 
      If theDay = 31 Then 
       Cells(13, 9).Interior.ColorIndex = 38 
       theErr = theErr + 1 
      End If 
      If InStr("2", CStr(theMonth)) Then 'February, with either 28 or 29 days: 
       If theDay = 30 Then 
        Cells(13, 9).Interior.ColorIndex = 38 
        theErr = theErr + 1 
       ElseIf theDay = 29 Then 
        If theYear Mod 4 <> 0 Then 'not a leap year: 
         Cells(13, 9).Interior.ColorIndex = 38 
         theErr = theErr + 1 
        End If 
       End If 
      End If 
     End If 
    End If 

    'Give error message if date error picked up: 
    If theErr <> 0 Then 
     MsgBox "Please check your date", vbOKOnly, "getDate" 
     Exit Sub 
    End If 

    theCurrentDate = DateSerial(theYear, theMonth, theDay) 

    If CDate(theCurrentDate) >= CDate(Cells(1, 1)) Then 
     'do some stuff 
    End If 
End Sub 

C'est un peu long .... mais cela fonctionne, et maintenant la région du système d'exploitation ne l'affecte pas.

Answer 1

Vous pouvez désactiver la gestion des erreurs et affecter la date de chaîne créée à une variable de date.

Vous pouvez ensuite vérifier si cela a causé une erreur; si c'est le cas, nous savons que la date utilisée n'est pas une date réelle.

Cela devrait fonctionner avec toutes les régions, car il ne dépend pas des paramètres de langue du système d'exploitation.

Sub getDate() 

    Dim checkDate As Date 

    'pick up date: 
    theDay = Cells(13, 9).Value 
    theMonth = Cells(13, 10).Value 
    theYear = Cells(13, 11).Value 

    theCurrentDate = theDay & " " & theMonth & " " & theYear 

    On Error Resume Next 
    checkDate = theCurrentDate 

    'highlight bad date: 
    If Err.Number > 0 Then 
     Cells(13, 9).Interior.ColorIndex = 38 
     Exit Sub 
    End If 

    On Error GoTo 0 

    If CDate(theCurrentDate) >= CDate(Cells(1, 1)) Then 
     'do some stuff 
    End If 
End Sub