XL 2019 Remplir plusieurs labels d'un Useform avec les dates d'un calendrier automatique

[Clemee61]

Bonjour,
J'ai un fichier Excel dans lequel j'ai crée une fiche d'inscription. Lorsqu'une personne se présente elle donne ses coordonnées que je rempli dans des texteBox et j'ai besoin de mettre une date d'arrivée et de départ. J'ai mis un calendrier automatique qui fonctionne car j'ai repris le travail d'un internaute mais sans le maitriser. J'essai de faire appel à ce même calendrier pour remplir d'autre case (en jaune dans ma fiche). Je ne m'en sors pas.
J'ai essayé de repartir d'autres exemples trouvés sur le forum mais rien y fait. Je suis bloqué depuis une semaine.
Quelqu'un peut-il m'aider ?
Je joins mon fichier avec tout le code (c'est un peu une usine à gaz mais j'ai mis en jaune "pétant" les cases incriminées !)
Cordialement,
Cédric

 

[vgendron]

1) Erreur lors du chargement : .BtnAller_à_Click 'clic sur le bouton "Aller A" pour charger les infos

j'en déduis que tu n'a pas repris le fichier version 15, mais que tu fais un copier coller du code dans ton fichier...? (parce que sinon, je ne comprend pas..ca fonctionne très bien chez moi..)

il faut que la procédure du bouton BtnAller_à_Click soit déclarée en public au lieu de private..

 

[Clemee61]

j'en déduis que tu n'a pas repris le fichier version 15, mais que tu fais un copier coller du code dans ton fichier...? (parce que sinon, je ne comprend pas..ca fonctionne très bien chez moi..)

il faut que la procédure du bouton BtnAller_à_Click soit déclarée en public au lieu de private..

Non non... Je prend toujours ta dernière version. Je ne fais pas de copier coller.

En fait quand on clique sur une ligne ça marche, mais quand on fait une recherche avant de cliquer sur la ligne alors ça bug.
Exemple :
- Je vais dans la recherche et je clique sur la première ligne avant de cliquer sur le bouton "fiche client"... pas de problème.
- Je vais dans la recherche et je tape NOM123. Je le sélectionne et je clique sur le bouton "fiche client"... là ça bug

 

[vgendron]

ok

vu
je ne sais pas pourquoi, mais dans le cas précis que tu décris, la recherche (set trouve....) ne trouve pas le numéro client ..
j'ai ajouté la conversion du numéro client de texte vers double

 

[Clemee61]

Là je n'ai rien compris à l'explication... mais ça marche impeccable

J'avais cherché pendant des heures pour charger la fiche directement depuis la recherche mais sans succès. J'en étais venu à repérer le numéro de client pour pouvoir cliquer sur "Aller à" dans le formulaire de la fiche d'inscription. Tu es trop trop fort

Peux tu jeter un œil (voire deux) sur les feuilles d'appel. J'ai fait un essai et elles ne se mettent pas à jour.
Le principe est qu'au clic sur le bouton du groupe concerné, la feuille d'appel se met à jour.
Les colonnes correspondent au nom indiqués sur la feuille d'appel (NOM, Prénom, Médaille de ruban jaune, Age, Date de fin de séjour et formule choisie).
Les enfants concernés doivent avoir la date du jour indiquée en cellule A2 comprise entre la date de début de séjour et la date d fin de séjour.
Les enfants concernés doivent avoir leur âge compris dans les fourchettes du tableau (D2:F7) de la feuille "Données_ref".

Merci d'avance

 

[vgendron]

Rectifié ici

 

[Clemee61]

Top !

Lorsque je crée une feuille mais que je n'ai pas encore les dates précises d'inscription, j'ai un bug si je ne rentre pas de date. Je peux rentrer une date en attendant mais est il possible de laisser les cases date de début et de fin de séjour vide.
Autrement dit a minima est-ce que je peux uniquement remplir un nom de famille de l'enfant 1 et sa date de naissance ?

 

[vgendron]

je pense qu'il faut que tu ailles enlever les "CDate()" dans les différentes macro
c'est ce qui provoque tes erreurs
cdate force un format date pour enregistrer dans la feuille excel
si le textbox est vide. cdate() renvoie une erreur

 

[Clemee61]

Je n'ai pas trouvé de CDate en dehors de ceux du code de l'USF.
Ce n'est pas grave. Je vais forcer l'entrée des dates comme l'entrée de la de naissance.

 

[vgendron]

si si. il y a bien du cdate dans le SaveUSF
les deux du séjour 1 sur lesquels il n'y avait pas de test: "if ...<>"" then

Sub SaveUSF(NumLigne As Integer, Nouveau As Boolean) 'macro de sauvegarde du formulaire dans la table excel
    With WsSource.ListObjects(1) 'avec la table de l'onglet "Inscription"
    'on enregistre les données du formulaire sur la feuille
        If Nouveau Then 'Sauv Col A
            .ListColumns("N° Client").DataBodyRange(NumLigne) = .ListColumns("N° Client").DataBodyRange(NumLigne - 1).Value + 1 'On met dans la cellule la valeur de Txt_N°_Client qui vaut la ligne précédent + 1==> Mettre plutot Max +1 ??
        Else
            .ListColumns("N° Client").DataBodyRange(NumLigne) = Me.Txt_N°_Client.Value
        End If
        
    'Renseignements Administratifs
        .ListColumns("Nom Adulte").DataBodyRange(NumLigne) = Application.Proper(Txt_Nom_Adulte.Value) 'Col G
        .ListColumns("N° Tel 1").DataBodyRange(NumLigne) = Txt_Tel_1.Value 'Col H
        .ListColumns("N° Tel 2").DataBodyRange(NumLigne) = Txt_Tel_2.Value 'Col I
        .ListColumns("Mail").DataBodyRange(NumLigne) = Txt_Mail.Value 'Col J
        .ListColumns("Réservation").DataBodyRange(NumLigne) = Cbx_Pre_reservation.Value 'Col AF
        .ListColumns("Etoile").DataBodyRange(NumLigne) = ToggleButtonEtoile.Value 'Col AT
        
    'Tarifs et paiement
        .ListColumns("Total Club").DataBodyRange(NumLigne) = Format(Txt_Total_Club.Value, "0 €") 'Col N
        .ListColumns("Total Nat").DataBodyRange(NumLigne) = Format(Txt_Total_Nat.Value, "0 €") 'Col AG
        'manque me.Text_addition_TOTAL 'pas de colonne associée = Calcul interne au formulaire (inutile??)
        .ListColumns("Total").DataBodyRange(NumLigne) = Format(Txt_TOTAL.Value, "0 €") 'Col S
        .ListColumns("Paiement").DataBodyRange(NumLigne) = Format(Txt_Paiement.Value, "0 €") 'Col T
        'manque Txt_Doit (21) la colonne contient une formule==> il faut peut etre vérifier que le calcul correspond au calcul interne du formulaire..?
        If Txt_Date_Paiement.Value = "" Then ' 'Col V
           .ListColumns("Date Paiement").DataBodyRange(NumLigne) = "Inconnue" 'à remplacer par
        Else
            .ListColumns("Date Paiement").DataBodyRange(NumLigne) = CDate(Txt_Date_Paiement.Value)
        End If
        
    'Gestion des cases à cocher 'Col W à AC
        .ListColumns("Chèque").DataBodyRange(NumLigne) = IIf(Case_chèque = True, "X", "")
        .ListColumns("Ch. Vac.").DataBodyRange(NumLigne) = IIf(Case_Chèque_vacances = True, "X", "")
        .ListColumns("Espèce").DataBodyRange(NumLigne) = IIf(Case_Espèce = True, "X", "")
        .ListColumns("Ch Vac Connect").DataBodyRange(NumLigne) = IIf(Case_Ch_Vac_Connect = True, "X", "")
        .ListColumns("Virement").DataBodyRange(NumLigne) = IIf(Case_Virement = True, "X", "")
        .ListColumns("Appli Tel").DataBodyRange(NumLigne) = IIf(Case_Appli_Tel = True, "X", "")
        .ListColumns("CB").DataBodyRange(NumLigne) = IIf(Case_CB = True, "X", "")
                
    'Notes
        .ListColumns("Note").DataBodyRange(NumLigne) = Txt_Notes.Value
        
    'Parasol
        .ListColumns("Nb Parasol").DataBodyRange(NumLigne) = Me.Txt_Nb_Parasol.Value
        .ListColumns("Durée Parasol").DataBodyRange(NumLigne) = Me.Txt_Durée_Parasol.Value
        .ListColumns("Tarif Parasol").DataBodyRange(NumLigne) = Format(Me.Txt_Tarif_Parasol.Value, "0 €")
        
     'Siège
        .ListColumns("Nb Siège").DataBodyRange(NumLigne) = Me.Txt_Nb_Siège.Value
        .ListColumns("Durée Siège").DataBodyRange(NumLigne) = Me.Txt_Durée_Siège.Value
        .ListColumns("Tarif Siège").DataBodyRange(NumLigne) = Format(Me.Txt_Tarif_Siège.Value, "0 €")
       
        
    '1er Séjour 'Col AN à AS
        .ListColumns("Total Club S1").DataBodyRange(NumLigne) = Format(Txt_Total_Club.Value, "0 €")
        .ListColumns("Total Nat S1").DataBodyRange(NumLigne) = Format(Txt_Tot_Nat_S1.Value, "0 €")
        .ListColumns("Paiement S1").DataBodyRange(NumLigne) = Format(Txt_Paiement_S1.Value, "0 €")
        .ListColumns("Date Paiement S1").DataBodyRange(NumLigne) = Txt_Date_Paiement_S1.Value
        .ListColumns("Total S1").DataBodyRange(NumLigne) = Format(Txt_TOTAL_S1.Value, "0 €")
        .ListColumns("Doit S1").DataBodyRange(NumLigne) = Format(Txt_DOIT_S1.Value, "0 €")
                    
    'les 4 enfants font la meme chose
        For i = 1 To 4
            If Me.Controls("Txt_Nom" & i) <> "" Then 's'il y a un nom d'enfant
                .ListColumns("Nom Enfant").DataBodyRange(NumLigne + i - 1) = UCase(Me.Controls("Txt_Nom" & i).Value)  'Col B
                .ListColumns("Prénom Enfant").DataBodyRange(NumLigne + i - 1) = Application.Proper(Me.Controls("Txt_Prénom" & i).Value)  'Col C
                .ListColumns("N° Client").DataBodyRange(NumLigne + i - 1) = .ListColumns("N° Client").DataBodyRange(NumLigne).Value  'On met dans le cellule la valeur de Txt_N°_Client qui vaut la ligne précédent + 1
                .ListColumns("Date de Naissance Enfant").DataBodyRange(NumLigne + i - 1) = CDate(Me.Controls("Txt_Age" & i).Value) 'Mettre Txt_Age au format date 'Col F
                If Me.Controls("Txt_DatDeb" & i) <> "" Then
                    .ListColumns("Début Séjour").DataBodyRange(NumLigne + i - 1) = CDate(Me.Controls("Txt_DatDeb" & i))  'col K
                End If
                If Me.Controls("Txt_DatFin" & i) <> "" Then
                    .ListColumns("Fin Séjour").DataBodyRange(NumLigne + i - 1) = CDate(Me.Controls("Txt_DatFin" & i)) 'Col L
                End If

                .ListColumns("Formule Club").DataBodyRange(NumLigne + i - 1) = Me.Controls("Cbx_Formule_Club" & i).Value  'Col M
                .ListColumns("Natation").DataBodyRange(NumLigne + i - 1) = Format(Me.Controls("Txt_Natation" & i).Value, "0 €")  'Col O
                .ListColumns("Tarif Nat").DataBodyRange(NumLigne + i - 1) = Format(Me.Controls("Txt_Tarif" & i).Value, "0 €")  'Col P
                
                If Me.Controls("Txt_Ruban_Jaune" & i) <> "" Then
                    .ListColumns("Date Ruban Jaune").DataBodyRange(NumLigne + i - 1) = CDate(Me.Controls("Txt_Ruban_Jaune" & i))  'Col AD
                End If
                .ListColumns("Diplômes").DataBodyRange(NumLigne + i - 1) = Me.Controls("Txt_Diplomes" & i).Value  'Col AH
                .ListColumns("Crêpe").DataBodyRange(NumLigne + i - 1) = Me.Controls("ToggleButtonCrepe" & i).Value  'manque le togglebuttoncrepe 'Col AI
                
                .ListColumns("Age Enfant").DataBodyRange(NumLigne + i - 1) = Calcul_Age(Me.Controls("Txt_Age" & i).Value, Format(Now, "dd/mm/yyyy"))  'Col E
                
                
                ' Copie Séjour 1 'Col AJ à AM
                If Séjour1 Then 'si la frame "Séjour1" a été chargée
                    If Me.Controls("TextBoxDebEnf" & i) <> "" Then
                        .ListColumns("Début Séjour S1").DataBodyRange(NumLigne + i - 1) = CDate(Me.Controls("TextBoxDebEnf" & i).Value)
                    End If
                    If Me.Controls("TextBoxFinEnf" & i) <> "" Then
                        .ListColumns("Fin Séjour S1").DataBodyRange(NumLigne + i - 1) = CDate(Me.Controls("TextBoxFinEnf" & i).Value)
                    End If
                    .ListColumns("Formule Club S1").DataBodyRange(NumLigne + i - 1) = Me.Controls("Cbx_Formule_ClubS1" & i).Value
                    .ListColumns("Natation S1").DataBodyRange(NumLigne + i - 1) = Format(Me.Controls("Txt_NatationEnf" & i).Value, "0 €")
                End If
            Else
                Exit For 'pour éviter de traiter un cas "hasardeux": pas d'enfant en 1, mais un enfant en 2 par exemple ==> ajouter un control pour forcer de remplir les 4 enfants DANS l'ordre sans laisser d'enfant "vide"
            End If
        Next i
    End With
End Sub

je viens de faire une manip "par erreur" qui confirme ce que je t'avais dit: il n'y a pas de gestion du nombre d'enfant (ajout /suppression)
à savoir: charger une fiche sur laquelle il y a 2 enfants
j'ai mis des noms prénom + date de naissance dans le 3eme
==> rien ne m'en empeche puisque les frames vides restent visibles
mais le plus grave, c'est qu'à l'enregistrement.. le 3eme enfant est enregistré sur la fiche suivante..

 

[vgendron]

pour le cdate, on pourrait s'affranchir de tous les tests if.. avec du "On error resume next".. mais.. j'aime pas ca
parce que quand il y a une erreur.. et bah.. le code continue quand meme. et la.. je ne sais pas du tout ce qu'il fait...

 

[Clemee61]

J'ai compris pour la gestion du nombre d'enfant (jusque là je t'avoue que c'était flou). Effectivement c'est gênant. Même si ça arrive rarement, on peut imaginer qu'un enfant s'inscrive puis quelques jours plus tard le grand frère se décide aussi. Si on ajoute le grand frère en modifiant la fiche, il va écraser la ligne suivante. J'ai vérifié et "ça marche".
Du coup je comprend mieux l'utilité de faire disparaitre les frames lorsqu'on rappelle une fiche. Cependant cela empêche de rappeler la fiche pour avoir tous les renseignements et de faire "Nouveau". Au final je pense qu'il vaut mieux réécrire la fiche plutôt que de risquer d'en écraser une autre. Donc au final masquer les frames lors d'un rappel de fiche est une bonne idée.

Pour le Cdate, maintenant que les fiches d'appel fonctionnent, c'est important qu'on le remplisse pour que tous les enfants apparaissent. Donc je préfère forcer l'entrée de dates.

 

[Clemee61]

Si j'appelle une fiche depuis l'USF ficheInscription : le bouton "Mofifier" fonctionne
Si j'appelle une fiche directement depuis l'USF Recherche : le bouton "Modicfier" fonctionne
Si j'appelle un fiche depuis l'USF "Recherche" mis des caractère dans la recherche : le bouton "Modifier" ne fonctionne pas

 

[vgendron]

apparemment, quand tu selectionnes une ligne via une saisie de texte dans le formulaire de recherche, il y a un espace qui s'invite dans le N° Client (ca doit se passer dans le code de chargement de la listbox...

en ajoutant un trim

 

[Clemee61]

Bon, à l'image de la vérification de ce que tu as fait pour la date de naissance j'ai voulu demander une confirmation d'une entrée sans date de séjour.
Et ça ne marche pas... Quelle surprise

Peux tu me corriger le code ?

 ' Controle de la saisie des dates de naissance
    For i = 1 To 4 'pour les 4 enfants
        If Me.Controls("Txt_Nom" & i) <> "" And Len(Me.Controls("Txt_Age" & i)) = 0 Then 'si il y a un nom, mais pas de date de naissance
            MsgBox ("Saisie de la date de naissance obligatoire !")
            Me.Controls("Txt_Age" & i).SetFocus
            Exit Sub
        End If
    Next i
    
    ' Controle de la saisie des dates de début de séjour
    
  For j = 1 To 4 'pour les 4 enfants
        If Me.Controls("Txt_DatDeb" & j) <> "" And Len(Me.Controls("Txt_DatDeb" & j)) = 0 Then 'si il y a un nom, mais pas de date de début de séjour
            If MsgBox("Êtes vous sur de ne pas mettre de date de séjour ?", vbYesNo, "Dates de séjour") = vbYes Then Exit Sub
                 Me.Controls("Txt_DatDeb" & j).SetFocus
            Exit Sub
        End If
    Next j
    
    For K = 1 To 4 'pour les 4 enfants
        If Me.Controls("Txt_DatFin" & K) <> "" And Len(Me.Controls("Txt_DatFin" & K)) = 0 Then 'si il y a un nom, mais pas de date de fin de séjour
            If MsgBox("Êtes vous sur de ne pas mettre de date de séjour ?", vbYesNo, "Dates de séjour") = vbYes Then Exit Sub
                 Me.Controls("Txt_DatFin" & K).SetFocus
            Exit Sub
        End If
    Next K

 

[vgendron]

Sans tester je dirais ceci

' Controle de la saisie des dates de naissance
    For i = 1 To 4 'pour les 4 enfants
        If Me.Controls("Txt_Nom" & i) <> "" And Len(Me.Controls("Txt_Age" & i)) = 0 Then 'si il y a un nom, mais pas de date de naissance
            MsgBox ("Saisie de la date de naissance obligatoire !")
            Me.Controls("Txt_Age" & i).SetFocus
            Exit Sub
        End If
    Next i
 
    ' Controle de la saisie des dates de début de séjour
 
  For j = 1 To 4 'pour les 4 enfants
        If Me.Controls("Txt_Nom" & j) <> "" And Len(Me.Controls("Txt_DatDeb" & j)) = 0 Then 'si il y a un nom, mais pas de date de début de séjour
            If MsgBox("Êtes vous sur de ne pas mettre de date de séjour ?", vbYesNo, "Dates de séjour") = vbYes Then
                 Me.Controls("Txt_DatDeb" & j).SetFocus
                Exit Sub
        End If
      end if
    Next j
 
    For K = 1 To 4 'pour les 4 enfants
        If Me.Controls("Txt_Nom" & K) <> "" And Len(Me.Controls("Txt_DatFin" & K)) = 0 Then 'si il y a un nom, mais pas de date de fin de séjour
            If MsgBox("Êtes vous sur de ne pas mettre de date de séjour ?", vbYesNo, "Dates de séjour") = vbYes Then
                 Me.Controls("Txt_DatFin" & K).SetFocus
                Exit Sub
        End If
   end if
    Next K