XL 2016 format date dans 2 TB

bidoutche

XLDnaute Occasionnel
Bonsoir,
j'ai un problème de format date.
dans mon usf 3 textbox pour le calcul entre les 2 dates cela fonctionne très bien. dans mon 1er TB le format JJ-MM-AA pas de soucis.
par contre dans le 2e le format affiche JJ/MM/AA alors que je mets des "-".
j'utilise les code suivant :
'Date de depart
Private Sub TB7_Change()
'exemple pour format date xx-xx-xxxx
Dim Valeur As Byte
TB7.MaxLength = 10 'nb caracteres maxi dans textbox
Valeur = Len(TB7)
If Valeur = 2 Or Valeur = 5 Then TB7 = TB7 & "-"
End Sub

'Date arrivée
Private Sub TB8_Change()
'exemple pour format date xx-xx-xxxx
Dim Valeur As Byte
TB8.MaxLength = 10 'nb caracteres maxi dans textbox
Valeur = Len(TB8)
If Valeur = 2 Or Valeur = 5 Then TB8 = TB8 & "-"
End Sub
'Duree
Private Sub TB8_AfterUpdate()
TB9.Value = CDate(TB8.Value) - CDate(TB7.Value)
End Sub
comment faire SVP?

Je vous remercie pour votre aide
 

patricktoulon

XLDnaute Barbatruc
bonjour
ca n'est pas insolite
primo
c'est tout simplement le principe de l’événement change qui est mal compris
et pour tout dire c'est pas cet événement qu'il faut utiliser quand les dates entrées sont tapées avec le clavier car on ne peut pas revenir en arrière si on c'est trompé

secondo
le afterupdate se déclenche quand on sort du textbox et donc si le textboxtb8 est le dernier dans l'ordre (tabindex)des controls dans le userform il ne se déclenchera pas

alors
vérifie que tb8 ne soit pas le dernier Control du userform

au plus simple
utilise le afterupdate du premier et second pour formater en date et controler si elle est valide

un peu plus complexe mais pour moi plus sur la données tapée doit être contrôlée a chaque touche
perso j'utilise le keydown tu devrais trouver quelque un de mes exemples dans le forum c'est recent en plus ;)
 

patricktoulon

XLDnaute Barbatruc
re
voici un ersatz de mon code datebox qui utilise mon astuce de l'interception du keyascii dans le keypress

tu tape les chiffre le séparateur est automatique

il y a un control de validité intégré qui efface la partie non valide automatiquement
exemple :31-02 va donner 31- ou bien encore 29-02-2019 va donner 29-02-

possibilité de reprendre a un endroit avant la fin de la chaîne déjà inscrite
( a pour effet de supprimer tout ce qui était après le .selstart)

les deux formats sont acceptés "DD /MM/YYYY" et "MM/DD/YYYY" LE séparateur etant celui de la constante bien Evidemment (à changer a son gré en haut de module )

le textbox3 sera mis a jour automatiquement sans passer par le afterupdate des que les textbox 1 et 2 seront dûment remplis et avec une date valide

si tu tiens absolument au format"xx" pour l’année je te ferais la modif ;)

VB:
Option Explicit
Const separator As String = "-"
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim t$
    With TextBox1
        If Not Chr(KeyAscii) Like "*[0-9]*" Then KeyAscii = 0
        t = Mid(.Value, 1, .SelStart)
        If Len(t) = 2 Or Len(t) = 5 Then t = t & separator
        t = t & Chr(KeyAscii):
        If Len(t) >= 6 Then If Not IsDate(Left(t, 6) & "2000") Then t = Left(t, 3)
        If Len(t) = 10 And Not IsDate(t) Then t = Left(t, 6)
        .Value = Mid(t, 1, 10)
        If Val(.Value) > 31 Then .Value = ""
    End With
    KeyAscii = 0
    controldatediff
End Sub

Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim t$
    With TextBox2
        If Not Chr(KeyAscii) Like "*[0-9]*" Then KeyAscii = 0
        t = Mid(.Value, 1, .SelStart)
        If Len(t) = 2 Or Len(t) = 5 Then t = t & separator
        t = t & Chr(KeyAscii):
        If Len(t) >= 6 Then If Not IsDate(Left(t, 6) & "2000") Then t = Left(t, 3)
        If Len(t) = 10 And Not IsDate(t) Then t = Left(t, 6)
        .Value = Mid(t, 1, 10)
        If Val(.Value) > 31 Then .Value = ""
    End With
    KeyAscii = 0
    controldatediff
End Sub

Private Sub controldatediff()
    If Len(TextBox1 & TextBox2) = 20 Then TextBox3 = CDate(TextBox2) - CDate(TextBox1)
End Sub

toutotomatic;)

edit
on diminue le code en généralisant l’événement keypress
et si tu avec 36 textbox date tu pourrais simplement faire un keypress global en transférant le code d'un dans une sub avec arguments et appeler cette sub a partir de tes textboxs

exemple
VB:
Option Explicit
Const separator As String = "-"
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    ControlValiddate TextBox1, KeyAscii
End Sub

Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  ControlValiddate TextBox2, KeyAscii
End Sub

Private Sub ControlValiddate(txtb, KeyAscii)
Dim t$
    With txtb
        If Not Chr(KeyAscii) Like "*[0-9]*" Then KeyAscii = 0
        t = Mid(.Value, 1, .SelStart)
        If Len(t) = 2 Or Len(t) = 5 Then t = t & separator
        t = t & Chr(KeyAscii):
        If Len(t) >= 6 Then If Not IsDate(Left(t, 6) & "2000") Then t = Left(t, 3): Beep
        If Len(t) = 10 And Not IsDate(t) Then t = Left(t, 6): Beep
        .Value = Mid(t, 1, 10)
        If Val(.Value) > 31 Then .Value = "": Beep
    End With
    KeyAscii = 0
    controldatediff
End Sub

Private Sub controldatediff()
    If Len(TextBox1 & TextBox2) = 20 Then TextBox3 = CDate(TextBox2) - CDate(TextBox1)
End Sub

nikel! non ? ;)
 

Pièces jointes

  • textbox calcul date1 moins date2.xlsm
    15.8 KB · Affichages: 12
Dernière édition:

bidoutche

XLDnaute Occasionnel
Bonjour,
tout d'abord un grand merci pour ton aide. j'ai collé le code dans mon projet. le format ne correspond pas et reste toujours aléatoire même si je le modifie manuellement et le calcul ente les deux dates ne se fait pas. qu'est ce que je ne fait pas bien? je te joins une copie d'écran qui sera peut être plus parlante. mais quand même un grand merci
 

Pièces jointes

  • Capture.PNG
    Capture.PNG
    19.3 KB · Affichages: 19

bidoutche

XLDnaute Occasionnel
je croyais que oui... mais non le calcule de nuit ne se fait pas.
mais tu vois sur la capture, quand j'appelle le nom de recherche et qu'il affiche le résultat, le format n'est pas identique même si je le modifie à la main, et ce pour toute la liste c'est l'un ou l'autre ou les 2 qui se mettent en format ../../2020 au lieu de ..-..-2020 a chaque résultat de recherche.
mais c'est super déjà de ton coup de main
 

Pièces jointes

  • Capture2.PNG
    Capture2.PNG
    23.7 KB · Affichages: 16

patricktoulon

XLDnaute Barbatruc
c'est parce que tu tape pas tes date tu les récupère deja d'une liste de date par le nom prenom et visiblement elle sont deja formatées"/" a ce que je vois dans ta source

une précision sur le contexte aurais été appréciable
on perdrait moins de temp (a decoder (entre les lignes) les demandes ,on est pas dans ta tète

donc ton exemple de code post1 n'a rien a voir avec la demande
on teste pas un len 2 ou len 7 quand on rentre une chaîne complète d'un coup

bref comment ces dates arrivent dans les textbox ??????????????????
 

bidoutche

XLDnaute Occasionnel
je ne suis pas un pro de VBA (comme pas mal d'entre nous), et quand on est pas pro on peut donner des explications qui peuvent être perçues différemment de ce que l'on pense. et j'en fait partie.
et ce que je ne comprends pas c'est pourquoi le format des TB revient en format avec "/" plutot qu'avec "-" ce ou que le format soit différent sur les 2 TB même si on les récupère d'une feuille excel qui sont formatées en "personnalisé" "jj-mm-aa".
 

patricktoulon

XLDnaute Barbatruc
re
tout simplement par ce que vba travaille ces dates avec:
démonstration:
'0 =US | 1= FR | 2 = canada et autres
MsgBox Application.International(xlDateOrder)
msgbox application.international(xldateseparator")

exemple teste ceci
msgbox cdate("01-01-2020")
ou bien encore
MsgBox CDate("2020-01-01")

comme tu va pouvoir le constater les deux msgbox vont te sortir la date au même format

la voila la raison

il te faut simplement dans ton cas dans le change
exemple
VB:
Private Sub TextBox1_Change()
If IsDate(TextBox1) And Format(TextBox1, "dd-mm-yy") <> TextBox1 Then TextBox1 = Format(TextBox1, "dd-mm-yy")
End Sub

attention tout de même sur l'interprètation de l'année quand la source est formatée a 2 chiffres pour l'année

démonstration en reformatant a 4 chiffres
exemple
TextBox1.Value = CDate("05/02/36")


Code:
Private Sub CommandButton1_Click()
TextBox1.Value = CDate("05/02/36")
End Sub

Private Sub TextBox1_Change()
If IsDate(TextBox1) And Format(TextBox1, "dd-mm-yyyy") <> TextBox1 Then TextBox1 = Format(TextBox1, "dd-mm-yyyy")
End Sub
le textbox affichera "05-02-1936"
et maintenant
Code:
Private Sub CommandButton1_Click()
TextBox1.Value = CDate("05/02/25")
End Sub

Private Sub TextBox1_Change()
If IsDate(TextBox1) And Format(TextBox1, "dd-mm-yyyy") <> TextBox1 Then TextBox1 = Format(TextBox1, "dd-mm-yyyy")
End Sub
le textbox affichera "05-02-2025"

rigolo non ????? :D ;)


conclusion
quand on maîtrise pas suffisamment les subtilités des formats de dates(excel/vba) mieux vaut utiliser celui de sa region; en ce qui nous concerne c'est "dd/mm/yyyy"

voila ;)
 

patricktoulon

XLDnaute Barbatruc
re
bonjour moi perso j'ai un gros soucis avec tes textboxs dates
notamment les date de naissance
tu veux 2 chiffres OK mais si je tape 05/01/18
c'est quoi 1918 ou 2018 ;)
alors tu va me dire que dans le contexte on devine facilement que c'est 1918 sauf que vba lui n'a pas cette acuité


d'autant plus que selon les 3 format géré par excel donc le 05/01/18
pourrait être le
18-01-2005
05-01-2018
05-01-1918
01-05-1918
01-05-2018

je te raconte pas l'ors de l'injection dans les cellules ce que ça va donner
d'autant plus que l'on vois bien les triangles verts dans les cellules de réception , ce qui veux dire que c'est au format texte , donc elles sont incalculables dans les cellules

bon bref je te l'ai fait au format que tu veux en saisie et en direct par bouton rechercher

j'ajouterais que tu pourrais globaliser certaines fonctions c'est un peu le cafoutch dans ce code

si j'ai le temps je regarderais pour totalement le réécrire
car c'est pas bon du tout ça sent le patchage multiple a plein nez dans l'avenir ;)
 

Pièces jointes

  • fiche 6bis.xlsm
    313.8 KB · Affichages: 8
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 198
Messages
2 086 145
Membres
103 130
dernier inscrit
FRCRUNGR