Obtenir un format date défini

Version imprimable

25/11/2009, 17h31
brunop3165

Obtenir un format date défini

Bonjour,

Dans un UserForm, je demande la saisie d'une date au format jj/mm/aa dans une TextBox (txtDate). Dans ma macro, j'analyse différents éléments de cette date sans problème ... sauf lorsque je cherche à obtenir l'année au format "aaaa". Je n'y arrive pas :(
J'ai essayé avec

Code:

TestAnnee = Format(txtDate.Value, "yyyy")

(j'attribue une valeur à ma variable TestAnnee). Si la date saisie est 28/02/68, aucun problème, TestAnnee = 1968. Mais si j'essaye avec la date 29/02/69, la macro plante sur cette partie du code. Excel m'affiche une erreur d'exécution '13', avec comme info une incompatibilité de type.
Vous l'aurez compris, il s'agit d'un test par rapport aux années bissextiles.

Est-ce que quelqu'un peut m'aider ? Si besoin, je peux donner le code complet de l'analyse de la date saisie qui fait appel à une fonction pour déterminer si l'année est bissextile.

Merci d'avance
Bruno
25/11/2009, 17h49
ucfoutu
Bonjour,

1) déjà : je ne sais pas si tu sais que le 29 février n'arrive que lors des années bissctiles ... (et en 69, ce n'en était pas une ) ==>> date inexistante ===>> cris de VB ....
2) tu veux recommencer le bug de l'an 2000 ? Non ? ===>>> les millésimes sur 4 chiffres, alors (on n'en est plus depuis belle lurette à faire des économies de 2 octets...+ 1 carambar.... les DD d'aujourd'hui te permettent largement de cesser d'être avare à ce point ).
3) si tu veux faire un test de "bissectilité", en plus :
---1) c'est facile :
Code:

1 2 annee = "1980" MsgBox IsDate("29/2/" & annee)
---2) on ne risque pas de pouvoir faire un test valable et fiable de "bissectilité" avec un millésime sur 2 chiffres ! (tu sais pourquoi ? :lol:... j'espère que oui !...)

Bonsoir,

Oui, je sais qu'il n'y a pas de 29/02 en 1969 (mon frère est né 1 an plus tôt, le 29/02/1968 :mouarf: et ce n'est pas une blague ), je connais bien cette "problématique". Je l'ai d'ailleurs abordée dans mon post initial ;)

Je pense qu'il est plus simple de montrer ce que j'ai écrit afin de voir ce qui ne va pas (je ne mets que la partie qui concerne le test). C'est parfois un peu de bricole, je le conçois :oops: :oops: :oops:, tous les cas de saisie possibles ne sont pas couverts, mais je fais avec mes faibles connaissances, et je pense que les principaux le sont.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Private Sub cmdRechercher_Click()
' Variables date
    Dim ValeurDate As String ' DateSaisie mise au format "jjmmaa" ("ddmmyy")
    If IsDate(txtDate) = True Then
        ValeurDate = Format(txtDate.Value, "yymmdd") ' Conversion au format anglais de la date saisie (txtDate)
        Else
        ValeurDate = txtDate.Value 'La variable reste au format saisi
    End If
'
' Vérification de la date saisie
    ' Déclaration et initialisation des variables de tests de la date saisie
    Dim TestGauche As Integer, TestCentre As Integer, TestDroite As Integer, TestLongueur As Integer
    Dim TestAnnee As Integer ' Année de la date saisie
    TestGauche = Left(txtDate, 2)
    TestCentre = Mid(txtDate, 4, 2)
    TestDroite = Right(txtDate, 2)
    TestLongueur = Len(txtDate)
    TestAnnee = Format(txtDate.Value, "yyyy")
    ' Tests de la date saisie
    If ValeurDate = "" Then
        MsgBox "Veuillez saisir une date.", vbExclamation, "Contrôle de la date saisie"
        Exit Sub
    ElseIf TestLongueur < 8 Or IsDate(txtDate) = False _
        Or TestGauche > 31 Then
        MsgBox "La date saisie n'est pas correcte.", vbExclamation, "Contrôle de la date saisie"
        txtDate.Value = ""
        txtDate.SetFocus
        Exit Sub
    ElseIf TestCentre = 2 Then
        If IsBissextile(TestAnnee) = False And TestGauche > 29 Then
            MsgBox "Il n'y a que 28 jours en février " & TestAnnee & " !", _
            vbExclamation, "Contrôle de la date saisie"
            txtDate.Value = ""
            txtDate.SetFocus
        Exit Sub
        End If
    End If
End Sub

Et la fonction qui détermine si l'année saisie est bissextile. J'ai récupéré cette fonction sur le net. Elle voit large puisqu'elle vaut quelle que soit l'année testée. Je l'ai laissée telle quelle, même si je n'ai besoin que d'une plage temporelle bien plus réduite, de quelques années seulement !

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Function IsBissextile(TestAnnee, Optional JulToGreg = 1582)
' Plage de validité des dates en VBA
  If TestAnnee < 100 Or TestAnnee > 9999 Then
    IsBissextile = CVErr(xlErrNum)
    Exit Function
  End If
' Calendrier Julien avant l'annee 1582
  If TestAnnee < JulToGreg Then
    IsBissextile = (TestAnnee Mod 4 = 0)
  Else
' Calendrier Grégorien à partir de l'annee 1582
    IsBissextile = (TestAnnee Mod 400 = 0) Or _
        (TestAnnee Mod 4 = 0 And (Not TestAnnee Mod 100 = 0))
  End If
End Function

Le choix d'une année à deux chiffres est expliqué sur un autre fil sur lequel tu m'as bien aidé.

25/11/2009, 20h44
mercatog

la question récurrente!
pourquoi utiliser des textbox pour saisir des date! et après contrôler la validité des données saisies...etc
un control datepicker (ou calendar ou monthview) est fait pour ça!!
sans nécessité de lignes de code!
bon c'était une remarque!
25/11/2009, 21h51
brunop3165

Bonsoir mercatog,

Avant de me lancer là dedans, j'ai cherché sur le net, assez longuement je dois dire. J'ai trouvé pas mal de chose, notamment ce fil. J'avoue ne pas avoir tout compris, et j'ai donc choisi de tester DTPicker qui me semblait le plus simple à utiliser, et le plus fiable.
Cela fonctionnait très bien pendant 5 ou 6 tests... jusqu'à ce que la hauteur du contrôle diminue peu à peu à chaque utilisation ... jusqu'à la disparition totale de DTPicker, sans que je ne comprenne pourquoi ! J'ai bien tenté de remettre le contrôle, d'imposer la hauteur directement dans le code (DTPicker1.Height = 16.25) en plus de la propriété, sans succès. De plus, je me suis aperçu que tous les PC sur lesquels j'ai testé la macro ne possède pas DTPicker (mon PC perso par exemple équipé de XP SP3 et Pack Office Pro 2003), ce qui plante la macro lorsqu'il y a absence de ce contrôle. Normal me semble-t-il !
Je n'ai pas réussi à comprendre le pourquoi du comment de ces deux choses, alors j'ai botté en touche et j'ai choisi la solution ci-dessus, car cette macro va devoir fonctionner sur plusieurs PC sans avoir besoin d'installer quoi que ce soit en plus sur chacun d'eux.
Si quelqu'un peut me donner un remède pour DTPicker, je reviens de suite vers ce contrôle. Sinon, je m'en tiendrai au bricolage que j'ai fait, sans contrôle du 29 février si je n'ai pas de solution.
A noter que sur mon PC perso, je n'ai ni DTPicker, ni Calendar, ni Monthview dans les contrôles supplémentaires :( Faut-il une version spécifique d'Excel pour les avoir ? Sont-ils (bien) cachés quelque part ?

Bruno
25/11/2009, 22h57
brunop3165

Bon ! Je viens de passer une bonne heure à chercher pourquoi je n'avais pas DTPicker sur mon PC. J'ai appris que ce contrôle (entre autres) n'était pas sur certaines anciennes versions du pack Office et j'ai notamment trouvé ça. Je viens donc de l'installer, et pour l'instant, ça va. Mais je ne sais toujours pas pourquoi le contrôle disparaissait précédemment :calim2:

Existe-t-il un code VBA pour contrôler l'existence de MSCOMCT2.OCX sur un PC (je sais faire), l'installer (je sais faire) et l'enregistrer automatiquement par Démarrer/Exécuter (je ne sais pas faire) s'il est absent ?
Question certainement bête dûe à mon statut de débutant, mais a-t-on besoin de cocher la croix du contrôle (Microsoft Date and Time Picker Control 6.0 (SP6)) dans la liste des contrôles du projet pour que la macro fonctionne sur le PC d'un "simple" utilisateur ? Si oui, peut-on le faire avec du code VBA ?
26/11/2009, 23h18
brunop3165

Bonsoir,

Comme indiqué hier soir, j'ai réinstallé DTPicker. Et comme précédemment, la hauteur du contrôle diminue peu à peu sans que j'arrive à cerner un contexte spécifique qui pourrait entrainer cette diminution :mur:

:help: Je commence à désespérer : DTPicker fait des siennes, et je bloque sur son remplacement pas du code .... :help:

Quant au code VBA qui me permettrait d'installer automatiquement MSCOMCT2.OCX, j'en ai trouvé un, mais comme je n'arrive pas à tout comprendre, je vais privilégier la création d'un petit mode opératoire qui permettra à chaque utilisateur d'installer ce fichier sur son PC. C'est une opération simple, tout le monde pourra facilement la réaliser ..... si tant est que j'arrive à supprimer ce problème de hauteur de contrôle qui diminue jusqu'à disparaître :cry:
Est-ce que l'un d'entre vous a déjà rencontré ce problème, et si oui, comment l'a-t-il résolu ?

Bruno

Bonsoir,

Personne pour me donner une solution ou une réponse à mes questions ? Tant pis, je continue mes recherches qui m'ont amené un peu plus loin, mais je bute toujours sur quelque chose. J'ai finalement pris le parti d'utiliser DTPicker, de tester sa présence, et de l'installer automatiquement si besoin.
Je cherche donc à installer automatiquement MSCOMCT2.OCX s'il est absent du PC sur lequel va tourner la macro, et à activer le contrôle DTPicker. Voici le code à ce jour. Il se trouve dans un module standard. Quelques remarques pour mieux comprendre ma démarche :
- selon le PC utilisé, system32 se trouve soit sous C:\windows, soit sous C:\WINNT
- fmMOA est un UserForm qui va permettre l'envoi d'un mail vers ma BAL pour m'aviser du problème rencontré par l'utilisateur
- je n'ai pas encore testé la copie du fichier ocx s'il est absent de system32
- j'initialise systématiquement le fichier ocx dans la base de registre (à vrai dire, je ne sais pas trop ce que ça donne si je le fais ou si je ne le fais pas lorsque le fichier se trouve déjà dans system32 :oops:)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 Private Sub TestsDTPicker() ' ' Définition des variables Dim CheminDTPicker As String ' 1ère partie chemin du fichier à copier Dim CheminDTPicker2 As String ' Chemin du fichier à copier Dim FichierSource As String ' Chemin du fichier à copier + nom du fichier Dim FichierCible As String ' Chemin du fichier "ocx" + nom du fichier Dim FichierOcx As String ' Nom du fichier "ocx" Dim TestDir As String ' Variable de test Dir ' ' Initialisation des variables FichierOcx = "MSCOMCT2.OCX" ' Nom du fichier à vérifier, voire à installer FichierSource = ThisWorkbook.Path & "\" & FichierOcx ' Chemin du répertoire devant contenir le fichier à copier ' ' Tests WINNT ou WINDOWS If RepertoireExiste("C:\WINNT") Then CheminDTPicker = "C:\WINNT\" ElseIf RepertoireExiste("C:\windows") Then CheminDTPicker = "C:\windows\" Else fmMOA.Show Exit Sub End If ' ' Tests de la présence du FichierOcx dans le répertoire "system32", ' que "system32" se trouve sous "C:\WINNT" ou "C:\windows" selon les PC CheminDTPicker2 = CheminDTPicker & "system32\" ' Initialisation variable Chemin répertoire devant contenir FichierOcx FichierCible = CheminDTPicker2 & FichierOcx ' Initialisation de la variable FichierCible TestDir = Dir(FichierCible) ' Le fichier existe-t-il dans system32 ? If TestDir = "" Then ' Si pas trouvé, vérifier que ce "ocx" est présent dans le même ' répertoire que l'application (ThisWorkbook.path) ' afin de le copier dans le répertoire système du PC de l'utilisateur If Dir(FichierSource) = "" Then fmMOA.Show Exit Sub End If End If ' 'Copie du fichier "ocx" vers le répertoire système ' FileCopy FichierSource, FichierCible ' ' Initialisation de l'"ocx" dans la base de registre Shell CheminDTPicker2 & "regsvr32.exe " & FichierOcx ' ' Ajouter la référence au projet On Error Resume Next ThisWorkbook.VBProject.References.AddFromFile FichierCible End Sub ' Fonction servant à tester l'existence du répertoire CheminDTPicker Function RepertoireExiste(CheminDTPicker As String) As Boolean On Error Resume Next RepertoireExiste = GetAttr(CheminDTPicker) And vbDirectory End Function
L'initialisation du fichier ocx fonctionne a priori bien puisque j'ai le message suivant :

Citation:

DllRegisterServer dans MSCOMCT2.OCX réussi.

En revanche, l'ajout de la référence au projet ne fonctionne pas. J'ai aussi testé avec le code suivant pour le même résultat :

Code:

Application.VBE.ActiveVBProject.References.AddFromFile FichierCible

Le code est-il mauvais ? Ai-je bien compris ce que voulait dire "Ajouter la référence au projet" ? Pour moi, cela est l'équivalent de cocher la case Microsoft Date and Time Picker Control 6.0 dans la liste des contrôles du projet (c'est en tous cas ce que je veux faire si c'est possible). Me trompe-je ??? J'ai un doute là dessus car il me semble avoir compris que MSCOMCT2.OCX sert à la fois pour DTPicker, Calendar ou Monthview.

Merci pour votre aide.
Bruno

03/12/2009, 14h35
brunop3165

Bonjour,

Je n'ai trouvé aucune réponse dans mes recherches, j'arrête donc là après avoir testé une autre solution très voisine de DTPicker, mais un peu moins ergonomique. Cela nécessite un poil plus de code, mais tant pis. J'ai opté pour Monthview, et ça a l'air de fonctionner sans problème.

Bruno

Salut brunop3165 et le forum
Pour les années à partir de 1900
Code:

1 2 3 4 5 6 7 Function Bis(An As Integer) As Boolean If Month(DateSerial(An, 2, 28)) = Month(DateSerial(An, 2, 29)) Then Bis = True Else Bis = False End If End Function
Fonction toute simple qui retourne VRAI si l'année est bissextile.
A+

04/12/2009, 15h20
brunop3165

Bonjour Gorfael,

Merci :D

Bruno