XL 2010 Difficulté à insérer plusieurs dates dans une même textbox pour remplir un tableau

didi2697

XLDnaute Nouveau
Bonjour à tous,
Je suis nouveau sur le forum, j'ai découvert le langage VBA en novembre dernier, depuis je me suis exercer à coder pour mon travail.
Alors tout d'abord un GRAND MERCI à tous pour vos conseils, votre partage...

Actuellement, je dois gérer une base de données qui permet le suivi de 600 employés pour leur visites médicales.
Grace à vos codes et vos explications j'ai réussi à faire un userforme avec un tableau Excel de 51 colonnes qui se rempli automatiquement.
J'ai plusieurs textbox ou je peux écrire plusieurs lignes en faisant "enter". Pratique pour insérer une nouvelle date sous une autre.

Voici le souci que je rencontre avec le bouton "modification".
Lorsque je rentre une nouvelle date de visite sous une autre dans ma textbox, il y a un blocage sur la textbox40. Voici mon code :
VB:
'pour le formulaire
Private Sub UserForm_Initialize()
Dim J As Long
    Set Ws = Sheets("2019") 'correspond au nom de l'onglet de mon tableau Excel
    With Me.ComboBox2
        For J = 2 To Ws.Range("C" & Rows.Count).End(xlUp).Row
            .AddItem Ws.Range("C" & J)
        Next J
    End With
 
'Pour la date de la demande
    With TextBox40
        'Autorise les mutilignes dans le TextBox
        'Attention: cette propriété est toujours à False par défaut
        .MultiLine = True
        'Spécifie que la touche ENTRÉE ajoutera une nouvelle ligne.
        .EnterKeyBehavior = True
    End With

'pour la date de la visite
With TextBox41
        'Autorise les mutilignes dans le TextBox
        'Attention: cette propriété est toujours à False par défaut
        .MultiLine = True
        'Spécifie que la touche ENTRÉE ajoutera une nouvelle ligne.
        .EnterKeyBehavior = True
    End With

'pour inscrire l'heure de la visite
With TextBox42
        'Autorise les mutilignes dans le TextBox
        'Attention: cette propriété est toujours à False par défaut
        .MultiLine = True
        'Spécifie que la touche ENTRÉE ajoutera une nouvelle ligne.
        .EnterKeyBehavior = True
    End With

'Pour inscrire la présence
With TextBox43
        'Autorise les mutilignes dans le TextBox
        'Attention: cette propriété est toujours à False par défaut
        .MultiLine = True
        'Spécifie que la touche ENTRÉE ajoutera une nouvelle ligne.
        .EnterKeyBehavior = True
    End With

'pour inscrire la date de la prochaine visite
With TextBox44
        'Autorise les mutilignes dans le TextBox
        'Attention: cette propriété est toujours à False par défaut
        .MultiLine = True
        'Spécifie que la touche ENTRÉE ajoutera une nouvelle ligne.
        .EnterKeyBehavior = True
    End With

'permet d'indiquer le format date dans notre zone de texte
    TextBox40.Text = "jj/mm/aaaa"
    If TextBox40 = "jj/mm/aaaa" Then
        TextBox40 = "" 'permet d'enlever le format date dans la zone de texte lorsque nous entrons une date
        End If
        If TextBox40 = "" Then
        TextBox40 = "jj/mm/aaaa"
        End If

    TextBox41.Text = "jj/mm/aaaa"
    If TextBox41 = "jj/mm/aaaa" Then
        TextBox41 = "" 'permet d'enlever le format date dans la zone de texte lorsque nous entrons une date
        End If
        If TextBox41 = "" Then
        TextBox41 = "jj/mm/aaaa"
        End If

    TextBox44.Text = "jj/mm/aaaa"
        If TextBox44 = "jj/mm/aaaa" Then
        TextBox44 = "" 'permet d'enlever le format date dans la zone de texte lorsque nous entrons une date
        End If
        If TextBox44 = "" Then
        TextBox44 = "jj/mm/aaaa"
        End If
End Sub

'zone de texte "Date de la demande"
Private Sub TextBox40_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not (KeyAscii > 46 And KeyAscii < 58) Then
KeyAscii = 0 'permet de taper uniquement les caractères du pavé numérique "0123456789/", pratique pour inscrire uniquement une date
End If
End Sub

'zone de texte "Date de début"
Private Sub TextBox41_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not (KeyAscii > 46 And KeyAscii < 58) Then
KeyAscii = 0 'permet de taper uniquement les caractères du pavé numérique "0123456789/", pratique pour inscrire uniquement une date
End If
End Sub

'zone de texte "Prochaine visite"
Private Sub TextBox44_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not (KeyAscii > 46 And KeyAscii < 58) Then
KeyAscii = 0 'permet de taper uniquement les caractères du pavé numérique "0123456789/", pratique pour inscrire uniquement une date
End If
End Sub

Private Sub CommandButton9_Click() 'pour le bouton "Modifications"
    Dim no_ligne, mligne As Integer
    'Sheets("2019").Select
    no_ligne = ComboBox2.ListIndex + 2
    no_ligne = ActiveCell.Row
    'Lig = 1 + Me.ComboBox2.ListIndex + 1

' Avec la feuille 2019
' Récupérer les données de la personne
With Sheets("2019")
    Cells(no_ligne, 3) = ComboBox2.Value
    Cells(no_ligne, 1) = ComboBox1.Value
    Cells(no_ligne, 2) = TextBox16.Value
    Cells(no_ligne, 4) = TextBox17.Value
    Cells(no_ligne, 5) = TextBox18.Value
        If Cells(no_ligne, 5) <> "jj/mm/aaaa" Then
        Cells(no_ligne, 5) = CDate(TextBox18) 'permet de garder le format date françaises
        Else: Cells(no_ligne, 5) = ""
        End If
    Cells(no_ligne, 6) = TextBox19.Value
        If Cells(no_ligne, 6) <> "jj/mm/aaaa" Then
        Cells(no_ligne, 6) = CDate(TextBox19) 'permet de garder le format date françaises
        Else: Cells(no_ligne, 6) = ""
        End If
    Cells(no_ligne, 7) = ComboBox3.Value
    Cells(no_ligne, 8) = ComboBox4.Value
    Cells(no_ligne, 9) = TextBox23.Value
    Cells(no_ligne, 10) = ComboBox5.Value
    Cells(no_ligne, 11) = TextBox24.Value
    Cells(no_ligne, 12) = TextBox28.Value
    Cells(no_ligne, 13) = ComboBox6.Value
    Cells(no_ligne, 14) = ComboBox7.Value
    Cells(no_ligne, 15) = ComboBox8.Value
    Cells(no_ligne, 16) = TextBox31.Value
    ' TextBox31.Text = TextBox31.Text & " " & ValeurSupplementaire
        If Cells(no_ligne, 16) = "" Then
        Cells(no_ligne, 16) = ""
        Else
        Cells(no_ligne, 16) = CDate(TextBox31) 'permet de garder le format date françaises
        End If
    Cells(no_ligne, 18) = TextBox32.Value
    Cells(no_ligne, 19) = TextBox33.Value
    Cells(no_ligne, 20) = TextBox34.Value
    Cells(no_ligne, 21) = TextBox35.Value
    Cells(no_ligne, 22) = TextBox36.Value
    Cells(no_ligne, 23) = TextBox37.Value
    Cells(no_ligne, 24) = TextBox38.Value
    Cells(no_ligne, 25) = TextBox39.Value
    Cells(no_ligne, 26) = TextBox40.Value
    TextBox40.Text = TextBox40.Text & " " & ValeurSupplementaire
        If Cells(no_ligne, 26) = "" Then
        Cells(no_ligne, 26) = ""
        Else
        Cells(no_ligne, 26) = CDate(TextBox40) 'permet de garder le format date françaises
        End If
    Cells(no_ligne, 27) = TextBox41.Value
    TextBox41.Text = TextBox41.Text & " " & ValeurSupplementaire
        If Cells(no_ligne, 27) = "" Then
        Cells(no_ligne, 27) = ""
        Else
        Cells(no_ligne, 27) = CDate(TextBox41) 'permet de garder le format date françaises
        End If
    Cells(no_ligne, 28) = ComboBox9.Value
    Cells(no_ligne, 29) = TextBox42.Value
    Cells(no_ligne, 30) = TextBox43.Value
    Cells(no_ligne, 31) = TextBox44.Value
    TextBox41.Text = TextBox44.Text & " " & ValeurSupplementaire
        If Cells(no_ligne, 31) = "" Then
        Cells(no_ligne, 31) = ""
        Else
        Cells(no_ligne, 31) = CDate(TextBox44) 'permet de garder le format date françaises
        End If
    Cells(no_ligne, 32) = TextBox45.Value
    Cells(no_ligne, 33) = TextBox46.Value
End With
End Sub
 

Staple1600

XLDnaute Barbatruc
Bonsoir didi2697 (Bienvenue sur le forum)

Publier ton code VBA "balisé" dans ton message, c'est bien
Joindre un fichier Excel exemple, contenant le dit-code et Userform et cie, c'est mieux ;)

NB: C'est plus simple et plus rapide que de récréer un classeur.

PS: Si tu joins un classeur, penses à bien l’anonymiser (RGPD oblige) avant.

EDITION: Juste pour infos
Tu remplir un ComboBox avec List (sans passer par une boucle) ;)
VB:
Private Sub UserForm_Initialize()
Set f =  Sheets("2019")
ComboBox2.List = f.Range(f.Cells(2, "C"), f.Cells(Rows.Count, "C").End(3)).Value
End Sub
 
Dernière édition:

didi2697

XLDnaute Nouveau
Bonsoir didi2697 (Bienvenue sur le forum)

Publier ton code VBA "balisé" dans ton message, c'est bien
Joindre un fichier Excel exemple, contenant le dit-code et Userform et cie, c'est mieux ;)

NB: C'est plus simple et plus rapide que de récréer un classeur.

PS: Si tu joins un classeur, penses à bien l’anonymiser (RGPD oblige) avant.

EDITION: Juste pour infos
Tu remplir un ComboBox avec List (sans passer par une boucle) ;)
VB:
Private Sub UserForm_Initialize()
Set f =  Sheets("2019")
ComboBox2.List = f.Range(f.Cells(2, "C"), f.Cells(Rows.Count, "C").End(3)).Value
End Sub
 

didi2697

XLDnaute Nouveau
Bonjour Staple1600,
Merci pour ta réactivité, en réalité le fichier excel exemple est trop lourd, je n'arrive pas à le joindre au message, pourtant il ne fait que 8355ko.
Y-a-t-il moyen de le réduire ???
 

Staple1600

XLDnaute Barbatruc
Re

On ne joint jamais le fichier original
On créé un fichier exemple pour l'occasion (simplifié et allégé) dont la seule vocation est d'illustrer la problématique rencontrée.

Si malgré la phase d'élagage, la taille reste conséquente, alors compresses le classeur avant envoi.
(Clic-droit depuis l'explorateur Windows -> Envoyer vers Dossiers compressés)
 

didi2697

XLDnaute Nouveau
Re

On ne joint jamais le fichier original
On créé un fichier exemple pour l'occasion (simplifié et allégé) dont la seule vocation est d'illustrer la problématique rencontrée.

Si malgré la phase d'élagage, la taille reste conséquente, alors compresses le classeur avant envoi.
(Clic-droit depuis l'explorateur Windows -> Envoyer vers Dossiers compressés)
Bonjour Staple1600,
Merci pour l'info voici mon fichier, je l'ai vraiment simplifié.
Bonne réception
 

Fichiers joints

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, didi2697

J'ai jeté un œil, pas de blocage chez moi sur la textbox40
De quel type de blocage parles-tu?
 

didi2697

XLDnaute Nouveau
Encore merci de prendre du temps pour mon souci
Tu ouvre le formulaire et choisi le premier nom, renseignements :
Dans la Textbox 40, tu laisse la date existante, tu fais "entrer" cela va à la ligne (de la textbox) pour insérer une autre date, et tu déclenches le bouton "modification", il y a le blocage avec le message "Erreur d’exécution '13' incompatibilité type", sur la ligne "Cells(no_ligne, 26) = CDate(TextBox40)"
(j'ai rajouter cette ligne pour garder le format date en français, systématiquement toutes les dates de la ligne changées en dates anglaises).
Cela ne le fait pas avec les textbox précédentes (n°18;19 et 31) car elles n'auront qu'une seule date.
J'espère avoir bien expliqué...
merci pour la réponse
 

didi2697

XLDnaute Nouveau
Encore merci de prendre du temps pour mon souci
Tu ouvre le formulaire et choisi le premier nom, renseignements :
Dans la Textbox 40, tu laisse la date existante, tu fais "entrer" cela va à la ligne (de la textbox) pour insérer une autre date, et tu déclenches le bouton "modification", il y a le blocage avec le message "Erreur d’exécution '13' incompatibilité type", sur la ligne "Cells(no_ligne, 26) = CDate(TextBox40)"
(j'ai rajouter cette ligne pour garder le format date en français, systématiquement toutes les dates de la ligne se changées en dates anglaises).
Cela ne le fait pas avec les textbox précédentes (n°18;19 et 31) car elles n'auront qu'une seule date, les deux textbox qui posent problème sont les n°40 et 41.
J'espère avoir bien expliqué...
merci pour la réponse
Bonjour Staple1600
Juste un complément, c'est que lorsque je débloque le message d'erreur, la deuxième date s'est bien insérer sous la première dans mon tableau.
y-t-il la possibilité de ne plus avoir ce message d'erreur de blocage ???
merci pour la réponse
Didi2697
 

Fichiers joints

ChTi160

XLDnaute Barbatruc
Bonjour didi2697
Bonjour le Fil (JM) ,le Forum
Première cause évidente , tu entres deux dates et tu formates le contenu de la TextBox ( CDate(TextBox40))
exemple:
VB:
 .Cells(no_ligne, 6) = CDate(TextBox40)
ça peut pas Marcher 12/05/2019 13/05/2019 , ce n'est pas une date !
enlevé le formatage soit :
CDate() a tout tes TextBox date
ex :
VB:
CDate(TextBox40)
donne TextBox40
et remplacé par
VB:
 .Cells(no_ligne, 6) = TextBox40
Pourquoi n'entres tu pas autant de ligne que de dates proposées et ensuite tu mets a jour en fonction de la date choisie (suppression des Lignes qui n'ont plus lieu d'être)
donc a voir !
jean marie
 
Dernière édition:

didi2697

XLDnaute Nouveau
Bonjour didi2697
Bonjour le Fil (JM) ,le Forum
Première cause évidente , tu entres deux dates et tu formates le contenu de la TextBox ( CDate(TextBox40))
exemple:
VB:
 .Cells(no_ligne, 6) = CDate(TextBox40)
ça peut pas Marcher 12/05/2019 13/05/2019 , ce n'est pas une date !
enlevé le formatage soit :
CDate() a tout tes TextBox date
ex :
VB:
CDate(TextBox40)
donne TextBox40
et remplacé par
VB:
 .Cells(no_ligne, 6) = TextBox40
Pourquoi n'entres tu pas autant de ligne que de dates proposées et ensuite tu mets a jour en fonction de la date choisie (suppression des Lignes qui n'ont plus lieu d'être)
donc a voir !
jean marie
Bonjour Jean-Marie
Merci beaucoup de t'avoir penché sur mon soucis.
Effectivement ta solution était la première utilisée, mais le souci à été :
1) les dates se changent en dates anglaises sur toute la ligne à chaque pression du bouton "modification".
2) comme il y a un suivi avec les dates je dois les conserver dans le tableau.

Si tu ouvre le formulaire et que tu prend le premier nom, tu clique sur "renseignement", tu insère une date dans la case "date de la visite", le message de blocage s'affiche "Erreur d'exécution '13' incompatibilité de type", tu débloque et ferme le formulaire : la date sera bien inscrite.
En fait, c'est ce message d'erreur que j'essaye d'enlever car les modifs s’insèrent quand même une fois que je "debloque" le message ????
Merci de ta collaboration
A+ Didi2697
 

Fichiers joints

ChTi160

XLDnaute Barbatruc
Bonjour Didi2697
Bonjour le Fil ,le Forum
peut etre en mettant
on error resume next
avant le transfert des dates vers les cellules
puis Err.clear
ou
on error goto 0
je vais regarder le fichier(msg depuis mon telephone)
jean marie
 

didi2697

XLDnaute Nouveau
Bonjour Didi2697
Bonjour le Fil ,le Forum
peut etre en mettant
on error resume next
avant le transfert des dates vers les cellules
puis Err.clear
ou
on error goto 0
je vais regarder le fichier(msg depuis mon telephone)
jean marie
Re bonjour Jean-Marie,
Combien je te suis reconnaissant, en suivant tes conseils il n'y a plus le message d'erreur, je joint le fichier, je pense que la façon dont j'ai codé est bizarre, mais le formulaire fonctionne à tout mes essais...
MERCI MERCI et ENCORE MERCI
Très bonne continuation à toi
 

Fichiers joints

ChTi160

XLDnaute Barbatruc
re
Tu n'as pas , je pense besoin d'utiliser autant de

VB:
On Error Resume Next
'Et
On Error GoTo 0
ça n'est déjà pas très académique Lol
Tu mets le gestionnaire au debut :
VB:
On Error Resume Next
      If Cells(no_ligne, 26) = "" Then  'Pourquoi ces deux Lignes ?????
        Cells(no_ligne, 26) = ""            ' Et Ici Ça veut dire si c'est vide je vide ????
        Else 
        Cells(no_ligne, 26) = CDate(TextBox40)
     End If
        Cells(no_ligne, 27) = TextBox41.Value 'Pourquoi cette Ligne ?????
     If Cells(no_ligne, 27) = "" Then  'Pourquoi ces deux Lignes ?????
        Cells(no_ligne, 27) = ""           ' Et Ici Ça veut dire si c'est vide je vide ????
        Else
        Cells(no_ligne, 27) = CDate(TextBox41)
     End If
On Error GoTo 0 'Puis en fin
Par exemple si seules les cellules des colonnes 26 et 27 sont concernées par le Multi dates
jean marie
 

didi2697

XLDnaute Nouveau
re
Tu n'as pas , je pense besoin d'utiliser autant de

VB:
On Error Resume Next
'Et
On Error GoTo 0
ça n'est déjà pas très académique Lol
Tu mets le gestionnaire au debut :
VB:
On Error Resume Next
      If Cells(no_ligne, 26) = "" Then  'Pourquoi ces deux Lignes ?????
        Cells(no_ligne, 26) = ""            ' Et Ici Ça veut dire si c'est vide je vide ????
        Else
        Cells(no_ligne, 26) = CDate(TextBox40)
     End If
        Cells(no_ligne, 27) = TextBox41.Value 'Pourquoi cette Ligne ?????
     If Cells(no_ligne, 27) = "" Then  'Pourquoi ces deux Lignes ?????
        Cells(no_ligne, 27) = ""           ' Et Ici Ça veut dire si c'est vide je vide ????
        Else
        Cells(no_ligne, 27) = CDate(TextBox41)
     End If
On Error GoTo 0 'Puis en fin
Par exemple si seules les cellules des colonnes 26 et 27 sont concernées par le Multi dates
jean marie
Encore merci Jean-Marie, c'est vraiment plus académique, et cela fonctionne, et merci d'avoir aussi fait remarquer la ligne : Cells(no_ligne, 27) = TextBox41.Value 'Pourquoi cette Ligne ?????
En fait elle n'y est pas pour la Textbox40, et bien elle permet apparemment d'insérer la nouvelle date, car la modif ne fonctionner pas avec le n°40, par contre en rajoutant cette ligne, les dates supl. s'insèrent bien correctement.
Merci beaucoup pour tes remarques
Cela fonctionne trés bien
A+ Didi2697
 

Discussions similaires


Haut Bas