Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

C

Clemee61

XLDnaute Junior
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
 

Pièces jointes

  • Inscriptions 2023 H.xlsm
    442.9 KB · Affichages: 33
Trier par date Trier par votes
C

Clemee61

XLDnaute Junior
C'est ça (juste en inversant la réponse Yes et No).
Merci

Maintenant je pense faire beaucoup de tests pour voir si tout fonctionne.

J'étais fier de ma fiche d'inscription. Je n'avais pas de quoi en fait ! Je n'aurais jamais espérer arriver à un tel niveau de qualité.

Merci beaucoup,

Je reviendrai pour faire le point de mes tests.

A bientôt
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
Bonjour
suite a notre entretien en MP avec @vgendron qui a soulevé un lièvre dans mon calendrier
qui portaitsur un problème de positionnement sur controls dans frames eventuellement scrollée dans un userform
j'ai donc ajouté cette éventualité dans le calendar
la voici donc
VB: 
Private Sub placementUF(Obj As Object)
    If Not Obj Is Nothing Then
        Dim Lft As Double, top As Double, P As Object, PInsWidth As Double, PInsHeight As Double
        Dim K As Double
        Lft = Obj.Left: top = Obj.top: Set P = Obj.Parent    ' Normalement Page, Frame ou UserForm
        Do
            PInsWidth = P.InsideWidth: PInsHeight = P.InsideHeight    ' Le Page en est pourvu, mais pas le Multipage.
            If TypeOf P Is MSForms.Page Then Set P = P.Parent    ' Prend le Multipage, car le Page est sans positionnement.
            K = (P.Width - PInsWidth) / 2: Lft = (Lft + P.Left + K): top = (top + P.top + P.Height - K - PInsHeight)
            If TypeOf P Is Frame Then top = top - P.ScrollTop + 2: Lft = Lft - (P.Width - PInsWidth) / 2
            If Not (TypeOf P Is MSForms.Frame Or TypeOf P Is MSForms.MultiPage) Then Exit Do
            Set P = P.Parent
        Loop
        Me.Left = Lft + ((Obj.Width / 2) * Px)     ' a gauche en top
        Me.top = top + ((Obj.Height / 2) * Py)
    End If
End Sub

démo
 
Vote positif 0 Vote négatif
C

Clemee61

XLDnaute Junior
Bonjour,

Je n'ai pas fini les tests mais voici déjà trois problèmes que je rencontre :

1) Faire le calcul "doit" seulement après la saisie du paiement et séparément des autres calculs.
En effet si la Txt_TOTAL indique 100 € après calcul et que je veux ne faire payer que 90 €. Je met dans la la Txt_TOTAL 90 €. Mais si je relance le calcul il me remet 100 € et du coup si le client ne paye que 90 €, il est indiqué qu'il doit encore 10 €.

2) Si j'inscrit un "€" dans une boite de tarif (case DOIT" par exemple mais aussi les autres) il y a un bug :
Private Sub textMonétaire_keypress(ByVal KeyAscii As MSForms.ReturnInteger): KeyAscii = IIf(Not Chr(KeyAscii) Like "[0-9€.]", 0, KeyAscii): End Sub

3) Fiche rempli à partir de l'USF saison précédente s'inscrit dans l'onglet "saisonPrécédente" au lieu de "Inscriptions"
 
Vote positif 0 Vote négatif

vgendron

XLDnaute Barbatruc
Hello

Je ne comprend plus trop ton projet et ta façon de procéder.. j'ai l'impression que ca change plus ou moins à chaque post.

le Total est calculé à partir des éléments que tu saisis
donc forcément, le montant dû dépend du Total et du paiement effectué
maintenant. si tu modifies entre temps le total.. pourquoi le calculer si en fait, tu y mets ce que tu veux
si tu effectues une "remise" quelconque, autant ajouter un control" Remise" et modifier le calcul de "Doit" pour en tenir compte.

le clic sur le bouton "Calculer" permet de faire tous les calculs.. donc si tu ne veux plus de ces calculs. il suffit de mettre en commentaire le/les blocs
j'ai présenté la macro de telle manière que ce soit facile de voir qu'est ce qui est calculé à quel moment avec des lignes de séparation '**********************

D'ailleurs, j'avais noté un truc étonnant dans le calcul des leçons de natation
une famille arrive avec 2 enfants
enfant 1: 4 lecons ==> 68Euros
enfant2: : 6 lecons ==> 96 Euros
Total facturé: 68+96 = 164 Euros

Par contre.. les parents vont voir que il y a un total de 6+4 leçons = 10.... pour lequel, le tarif n'est que de 134 €

pour le symbole €,
le mieux c'est de ne pas le saisir...
et laisser le formatage des textbox auto après saisie
du coup, les controls dont le tag est "Monétaire", tu les repasses en "Numérique"

pour le 3.. bah. oui. c'était le principe
selon la feuille de travail.. on recherche, on charge, et on enregistre sur la feuille de travail..
maintenant.. si quelque soit la feuille de "chargement", tu enregistres toujours dans inscriptions, il faut aller dans la macro "SaveUSF" pour modifier la feuille cible... mais la. tu vas avoir un pb de numéro de ligne cible.
 
Vote positif 0 Vote négatif

vgendron

XLDnaute Barbatruc
pour le montant tu peux peut etre faire ceci
VB: 
Private Sub Cbn_Calculer_Click() 'tous les calculs sont effectués ici==> Plus besoin de cliquer dans les différentes cases de total.
'******************************************Calcul du Total_Club*******************************
    '=f(nombre de jours Hors dimanche, formule) ==> selon Grille Tarifaire t_Tarifs_Club
        'Cette boucle charge les données des frames enfants pour faire les calculs
        For i = 1 To 4
            If Me.Controls("Txt_DatDeb" & i) <> "" And Me.Controls("Txt_DatFin" & i) <> "" Then
                Me.Controls("Text_Nb_Jours_Enfant" & i) = NbJoursHorsDimanche(CDate(Me.Controls("Txt_DatDeb" & i)), CDate(Me.Controls("Txt_DatFin" & i))) 'Nb de jours HORS dimanche
                With Sheets("Données_ref").ListObjects("t_Tarifs_club") 'on récupère le tarif dans la grille
                    Me.Controls("Text_Tarif_Enfant" & i) = Format(.ListColumns(CStr(Me.Controls("Text_Nb_Jours_Enfant" & i))).DataBodyRange(Me.Controls("Cbx_Formule_Club" & i).ListIndex + 1), "0 €")
                    NbEnf = NbEnf + 1
                End With
            Else
                Me.Controls("Text_Nb_Jours_Enfant" & i) = 0
                Me.Controls("Text_Tarif_Enfant" & i) = 0
            End If
        Next i
        
        'Calcul Total AVANT la remise
        Me.Txt_Tot_SansRemise = CDbl(Me.Text_Tarif_Enfant1) + CDbl(Me.Text_Tarif_Enfant2) + CDbl(Me.Text_Tarif_Enfant3) + CDbl(Me.Text_Tarif_Enfant4)
        
        'calcul de la remise fonction du nb d'enfants
        Total = Me.Txt_Tot_SansRemise
        Select Case NbEnf
            Case 0 'ce cas ne devrait pas exister
            
            Case 1 'pas de remise
                Total = Total
            Case 2 '5%
                Total = 0.95 * Total
            Case 3 '10%
                Total = 0.9 * Total
            Case 4 '15%
                Total = 0.85 * Total
        End Select
        Me.Txt_Tot_AvecRemise = Total
        
        'on place le total AVEC ou SANS remise dans Total_Club en fonction de l'option boutton sélectionné 'pour changer valeur par défaut(Avec Remise) aller dans l'initialize
        Me.Txt_Total_Club = IIf(Me.Ob_AvantRemise, Format(Me.Txt_Tot_SansRemise, "0 €"), Format(Me.Txt_Tot_AvecRemise, "0 €"))
        
    '************************************************************************************************
    
'******************************************Calcul du Total_Nat*******************************
    Total = 0
    For i = 1 To 4 'on récupère les 4 tarifs déjà calculés dans les frames enfants
        If Me.Controls("Fr_Enfant_" & i).Visible Then
            If Me.Controls("txt_Tarif" & i) = "" Then Me.Controls("txt_Tarif" & i) = 0
            Total = Total + Me.Controls("txt_Tarif" & i)
        End If
    Next i
    Me.Txt_Total_Nat = Format(Total, "0 €")
    '************************************************************************************************
    
'*************************************Calcul du Total_Parasol &Siège*****************************
    UpdateParasol 'on lance l'update pour éviter bug quand les controles sont vides
    UpdateSiège
    Me.Txt_Total_Par = Format(CDbl(Me.Txt_Tarif_Parasol) + CDbl(Me.Txt_Tarif_Siège), "0 €")
    '************************************************************************************************
    
'********************************************Calcul du Total*************************************
    Total = CDbl(Me.Txt_Total_Club) + CDbl(Me.Txt_Total_Nat) + CDbl(Me.Txt_Total_Par)
    If Me.Txt_TOTAL <> "" Then
        If Total <> CDbl(Me.Txt_TOTAL) Then
            If MsgBox("le montant calculé ne correspond pas au montant Total Saisi" & Chr(10) & "Etes-vous sur de vouloir utiliser le montant saisi?", vbYesNo) = vbNo Then
                Me.Txt_TOTAL = Format(Total, "0 €")
            End If
        End If
    Else
        Me.Txt_TOTAL = 0
    End If
    '************************************************************************************************
    
'********************************************Calcul du "Doit"*************************************
    Me.Txt_Paiement = IIf(Me.Txt_Paiement = "", 0, Me.Txt_Paiement)
    Me.Txt_Doit = Format(CDbl(Me.Txt_TOTAL) - CDbl(Me.Txt_Paiement), "0 €")
    Me.Txt_Doit.Value = Format(Me.Txt_Doit.Value, "0.00 €") 'Formatage
    Me.Txt_Doit.BackColor = IIf(CDbl(Txt_Doit.Value) > 0, &HEB, &HE0E0E0) 'coloration
    '************************************************************************************************
End Sub
 
Vote positif 0 Vote négatif
C

Clemee61

XLDnaute Junior
Bonjour vgendron,

Je t'ai fâché ! Désolé

De ton point de vue je comprend que tu ais l'impression que je change d'avis. En fait non, c'est patricktoulon qui a raison : si j'avais mieux préparé sur le papier en amont, les choses seraient plus claires.

Pour la remise tu as raison, ça règle tout le problème si je peux intervenir sur le total via une remise. J'imaginais pouvoir le faire en changeant le chiffre du total directement mais c'est pas malin.

Pour ta présentation du code : c'est tout plein de vert et c'est parfait pour moi pour essayer de m'y retrouver. Je dois avouer qu'à la vitesse où tu vas, je n'ai pas tout le temps regarder le code avant de poser une question. Alors je vais tacher de retourner regarder le code à commencer par le dernier post que tu viens d'envoyer.

Pour la natation le tarif est normal. Les leçons sont purement individuels. Du coup même deux frères sont considérés comme deux clients différents et ne cumulent pas leur leçon pour bénéficier d'un forfait.

Pour le symbole €. Dans la case paiement on rentre la somme réglée. Du coup machinalement j'ai mis un € derrière le chiffre. Le mieux est d'empêcher la saisie d'autre caractères que les chiffres.

Pour le 3 il n'y a pas d'intérêt à modifier les données de la saison précédentes. La recherche et la fiche ne servent qu'à récupérer les données, les compléter puis en cliquant sur "Nouveau" les mettre dans les inscriptions de l'année en cours. Peut-être que le mieux et de bloquer le bouton "Modifier" comme tu l'as déjà fait pour éviter tout problème.

Bon maintenant je vais lire et essayer de comprendre ton code...
 
Vote positif 0 Vote négatif

vgendron

XLDnaute Barbatruc
pour le format €
plutot que de remplacer les tags, laisse les comme ils sont
mais ajoute ce bout de code dans la module de classe cTextBox
VB: 
Private Sub textMonétaire_Change()
    Dim x$, p%
    x = Replace(textMonétaire, ",", ".")
    p = textMonétaire.SelStart - (x = "0") + (x Like "0?*.*") 'mémorise
    textMonétaire = IIf(IsNumeric(Left(x, 1)), Format(Val(x), "0 €"), "")
    textMonétaire.SelStart = p
End Sub
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
re
De ton point de vue je comprend que tu ais l'impression que je change d'avis. En fait non, c'est patricktoulon qui a raison : si j'avais mieux préparé sur le papier en amont, les choses seraient plus claires.
Cliquez pour agrandir...
a ben voila on y arrive
et ça fait 111 messages que vgendron s’échine a te sortir un truc viable ,qui de toute façon ne le sera pas longtemps vu que les informations arrive au compte goutte
et qu'a chaque fois il est obligé de patcher
je comprends bien que quand on est pas développeur toutes ces tracasseries sont abstraites et on en imagine même pas la moitié
c'est pour cela que je dis toujours faite un plan de projet sur une feuille blanche ou un bloknote
y a pas besoins d'etre developpeur pour ça
 
Vote positif 0 Vote négatif
C

Clemee61

XLDnaute Junior
 
Vote positif 0 Vote négatif
C

Clemee61

XLDnaute Junior
Là par contre je ne comprend pas.
Les tags et la formule de classe je ne sais pas ce que c'est.
Les tags est-ce à dire que tous les 0.00 € que j'ai remplacé par 0 € doivent être remis comme avant ? ou pas du tout !
 
Vote positif 0 Vote négatif

vgendron

XLDnaute Barbatruc
j'ai effectivement vu que tu avais changé le format monétaire de 0.00€ en 0 €
==> ca veut dire que tous les montants sont sans chiffre après la virgule.. c'est fait exprès? ou c'est parce que tu n'avais pas compris ?
bon. en meme temps.. ce n'est qu'une question d'affichage..

le tag: c'est une propriété des controls
dans le tag, j'ai mis soit "Numérique", soit "Date" soit "Monétaire"
selon la valeur du Tag, la saisie est controlée (et définie dans le module de classe)
 
Vote positif 0 Vote négatif
C

Clemee61

XLDnaute Junior
Je suis parti de chez moi avec un ordinateur portable pour continuer à travailler sur la fiche. Malheureusement la taille de l'écran étant plus petite, je ne vois pas l'USF entier. Je suis allé glaner quelques solutions sur internet mais pour l'instant aucune ne fonctionne. Y a-t-il une fonction toute faite qui permet d'adapter un USF à la taille de l'écran ou cela doit il nécessairement passer par du code ?
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…