Résolu le format de date change alternativement sur chaque ligne...

rom1z

XLDnaute Nouveau
Bonjour,
j'ai un soucis avec les formats de date, après avoir inscrit des dates dans un formulaire,(feuille emprunt materiel) à l'écriture dans le tableau, excel inscrit les dates une fois sur deux en jj/mm/aa ou mm/jj/aa quand ces dates sont inférieures à 12, il doit y avoir un soucis de conversion date us/eu mais pourquoi alternativement ??? très bizarre...

si vous avez une idée je suis preneur...
merci !

Fichiers joints
 

Fichiers joints

sousou

XLDnaute Accro
Bonjour ta textebox renvoi du texte et non une date excel

Essai comme-ceci
Sheets("EMPRUNT MATERIEL").Range("A65000").End(xlUp).Offset(0, 4).Value = CDate(TextBox2.Value)
Sheets("EMPRUNT MATERIEL").Range("A65000").End(xlUp).Offset(0, 5).Value = CDate(TextBox3.Value)
 

Ikito

XLDnaute Occasionnel
Bonjour rom1z,

Quand tu traites avec des dates je te conseille de passer par les Dates converties en chiffres.

Par exemple le 05/08/2019 correspond à 43682. Pour information, ce nombre correspond au nombre de jours écoulés depuis le 00/01/1900.

En VBA :

VB:
VarDate = Cells(1,1) 'Date en String par exemple 05/08/2019'

DateConvertie = CLng(VarDate) 'Date en nombre'
Edit : Bonjour sousou
 

rom1z

XLDnaute Nouveau
Merci à tous les deux pour vos réponses, j'ai testé la proposition de sousou de la manière ci dessous mais cela ne change rien, le format alterne toujours 1 ligne sur 2 entre l'us et l'eu :
VB:
Private Sub TextBox2_AfterUpdate()
On Error GoTo messagerreur
TextBox2 = CDate(TextBox2.Value)

                    Sheets("EMPRUNT MATERIEL").Range("T4").Value = TextBox2.Value
                    
Exit Sub
messagerreur:
    MsgBox ("mauvais format de date, saisir JJ/MM/AAAA")
    TextBox2 = Empty
End Sub
 

rom1z

XLDnaute Nouveau
Et Ikito je ne vois pas comment intégrer ta proposition de code à ma textbox sachant qu'il faut qu'elle continue d'afficher un format date jj/mm/aaaa après l'avoir remplie et qu'elle envoie ensuite cette date dans le tableau.
 

Ikito

XLDnaute Occasionnel
Re,

VB:
Private Sub TextBox2_AfterUpdate()
On Error GoTo messagerreur
TextBox2 = CDate(TextBox2.Value)
                    
                    DateRecup = CLng(TextBox2.Value)
                    Sheets("EMPRUNT MATERIEL").Range("T4").Value = DateRecup 'Mettre le format de celulle concernée en Date.
                    
Exit Sub
messagerreur:
    MsgBox ("mauvais format de date, saisir JJ/MM/AAAA")
    TextBox2 = Empty
End Sub
 

Ikito

XLDnaute Occasionnel
Et Ikito je ne vois pas comment intégrer ta proposition de code à ma textbox sachant qu'il faut qu'elle continue d'afficher un format date jj/mm/aaaa après l'avoir remplie et qu'elle envoie ensuite cette date dans le tableau.
Tu fais le traitement par la suite, voir le code ci-dessus.
 

Roblochon

XLDnaute Impliqué
Bonjour,
Bonjour @sousou ,@Ikito :

Peut-être une autre suggestion. remplacer tous les
Sheets("EMPRUNT MATERIEL").Range("A65000").End(xlUp).Offset(0, ....
en utilisant la variable Ligne qu'il initialise mais dont il ne se sert pas/

Ce serait bien également, que vous sachiez choisir entre les .Text ou .Value des objets après avoir consulté l'aide excel sur les différents propriétés dont les subtilités peuvent cacher des pièges.
Exemple: Combobox1.Text peut être différent de Combobox1.Value et Combobox1.List(n,n) je vous laisse deviner et ou chercher les différences.

VB:
With Sheets("EMPRUNT MATERIEL")
     ligne = .Range("A" & Rows.Count).End(xlUp).Row + 1
     .Cells(ligne, 1) = ComboBox1.Text
     .Cells(ligne, 2) = ListBox2.List(obj, 0)
     .Cells(ligne, 3) = CDate(TextBox1.Value)
     .Cells(ligne, 4) = CDate(TextBox2.Value)
     .Cells(ligne, 5) = TextBox3
     .Cells(ligne, 6) = TextBox4
End With
[Edit] mettre la boucle for à l'interieur du With Sheets....End With.

Cordialement
 
Dernière édition:

rom1z

XLDnaute Nouveau
Ikito, sorry mais ton code me renvoie une erreur d'incompatibilité de type sur le dateRecup
 

Ikito

XLDnaute Occasionnel
Re,

Tout dépend quel est le texte entré dans la TextBox, si la forme est jj/mm/aaaa ça devrait bien se passer...

Edit : Avec le distingo de Roblochon :rolleyes:
 

Roblochon

XLDnaute Impliqué
Re,

Voilà, testé sur votre fichier du post#1 qui fonctionne pour peu que les dates soient au format jj/mm/aaaa dans les textbox.

VB:
Private Sub CommandButton1_Click()
    Dim obj As Long, ligne As Long
    Dim lr As ListRow
    If TextBox1 = "" Or TextBox2 = "" Or TextBox3 = "" Or TextBox4 = "" Or ComboBox1 = "" Or ListBox2 = "" Then
        MsgBox ("Eh non ! T'as pas tout rempli !")
        GoTo 6
    End If
    With Sheets("EMPRUNT MATERIEL").ListObjects("Tableau1")
        For obj = 0 To ListBox2.ListCount - 1
            With .ListRows.Add().Range
                .Cells(1, 1) = ComboBox1.Text
                .Cells(1, 3) = ListBox2.List(obj, 0)
                .Cells(1, 4) = CDate(TextBox1.Value)
                .Cells(1, 5) = CDate(TextBox2.Value)
                .Cells(1, 6) = TextBox3
                .Cells(1, 7) = TextBox4
            End With
        Next obj
    End With
    ListBox2.Clear
6
End Sub
Sans la colonne 'initiales' les lignes d'enregistrement auraient pu s'écrirent en une seule:
.ListRows.Add().Range.resize(,6).Value = Array(ComboBox1.Text, ListBox2.List(obj, 0), CDate(TextBox1.Text), CDate(TextBox2.Text), TextBox3.Text, TextBox4.Text)


Petit conseil, prévoyez des tests sur les valeurs et leur type avant de les enregistrer. Ne jamais faire confiance aux données saisies par l'utilisateur.

Bonne soirée
 

rom1z

XLDnaute Nouveau
Re,

Voilà, testé sur votre fichier du post#1 qui fonctionne pour peu que les dates soient au format jj/mm/aaaa dans les textbox.

VB:
Private Sub CommandButton1_Click()
    Dim obj As Long, ligne As Long
    Dim lr As ListRow
    If TextBox1 = "" Or TextBox2 = "" Or TextBox3 = "" Or TextBox4 = "" Or ComboBox1 = "" Or ListBox2 = "" Then
        MsgBox ("Eh non ! T'as pas tout rempli !")
        GoTo 6
    End If
    With Sheets("EMPRUNT MATERIEL").ListObjects("Tableau1")
        For obj = 0 To ListBox2.ListCount - 1
            With .ListRows.Add().Range
                .Cells(1, 1) = ComboBox1.Text
                .Cells(1, 3) = ListBox2.List(obj, 0)
                .Cells(1, 4) = CDate(TextBox1.Value)
                .Cells(1, 5) = CDate(TextBox2.Value)
                .Cells(1, 6) = TextBox3
                .Cells(1, 7) = TextBox4
            End With
        Next obj
    End With
    ListBox2.Clear
6
End Sub
Sans la colonne 'initiales' les lignes d'enregistrement auraient pu s'écrirent en une seule:
.ListRows.Add().Range.resize(,6).Value = Array(ComboBox1.Text, ListBox2.List(obj, 0), CDate(TextBox1.Text), CDate(TextBox2.Text), TextBox3.Text, TextBox4.Text)


Petit conseil, prévoyez des tests sur les valeurs et leur type avant de les enregistrer. Ne jamais faire confiance aux données saisies par l'utilisateur.

Bonne soirée
Merci à tous j'ai modifié mon code sur les conseils de Roblochon avec la variable ligne qui c'est vrai ne servait à rien mais je me suis retrouvé avec un décalage de colonne que j'ai corrigé en indiquant la lettre de colonne dans le Cells, et plus de problème !, je vais aussi tester cette nouvelle proposition de roblochon qui me semble plus propre... et ajouter un contrôle d'entrée sur les textbox de date.
merci, voici le code qui fonctionne aussi pour l'instant:
VB:
            With Sheets("EMPRUNT MATERIEL")
     ligne = Sheets("EMPRUNT MATERIEL").Range("A" & Rows.Count).End(xlUp).Row + 1
     .Cells(ligne, "A") = ComboBox1.Value
     .Cells(ligne, "C") = ListBox2.List(obj, 0)
     .Cells(ligne, "D") = CDate(TextBox1.Value)
     .Cells(ligne, "E") = CDate(TextBox2.Value)
     .Cells(ligne, "F") = TextBox3
     .Cells(ligne, "G") = TextBox4
End With
 

rom1z

XLDnaute Nouveau
Merci Roblochon, j'ai effectivement déplacé ma colonne initiales qui ne me sert que pour créer le code mission et remplacé les différentes lignes d'enregistrement par l'unique ligne, c'est parfait tout ça fonctionne, bravo ! :D
 

Roblochon

XLDnaute Impliqué
Bonjour,

Dans la ligne
ligne = Sheets("EMPRUNT MATERIEL").Range("A" & Rows.Count).End(xlUp).Row + 1
Enlever "Sheets("EMPRUNT MATERIEL")" qui ne sert plus à rien puisque dans le corps du WITH...END WITH
C' est est un oubli de ma part.

Bonne programation
 

Discussions similaires


Haut Bas