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

 

[ChTi160]

Re
Ton problème vient du fait que lorsque tu traites une valeur négative via ta procédure

Sub textMonétaire_Change

Elle te renvoie une valeur Vide ("")

 textMonétaire = IIf(IsNumeric(Left(x, 1)), Format(Val(x), "0 €"), "")

Left(x,1) de "-20 €" renvoie "-" donc textMonétaire renvoie Vide ;
Ce qui occasionne l'erreur lorsque tu transformes ce "" en CDBl()
dans :

 Me.Txt_Doit.BackColor = IIf(CDbl(Txt_Doit.Value) > 0, &HEB, &HE0E0E0) 'coloration

Jean marie

 

[Clemee61]

C'est vu,
En supprimant cette partie (Sub textMonétaire_Change) ça règle le problème effectivement mais ça en crée d'autres que je vais essayer de solutionner.
Merci beaucoup

 

[patricktoulon]

re
bonjour
juste en passant

Me.Txt_Doit.BackColor = Array(&HEB, &HE0E0E0)(Abs(CDbl(Txt_Doit) <= 0))

 

[Clemee61]

re
bonjour
juste en passant
Me.Txt_Doit.BackColor = Array(&HEB, &HE0E0E0)(Abs(CDbl(Txt_Doit) <= 0))

Bonjour patricktoulon,
J'ai imaginé qu'il fallait remplacer la ligne de code qui colore la case par la tienne mais cela ne change rien.
Peux tu me dire quelle est l'utilité de ta ligne de code s'il te plait ?

 

[patricktoulon]

re
ben au change si c'est rien ou zero ou - de zero c'est gris sinon c'est rouge

 

[Clemee61]

Ah d'accord

 

[Clemee61]

Bon je reviens encore vers vous :

La case paiement doit être réservée uniquement à des chiffres. C'est le cas : si on tape une lettre, rien ne se passe. Mais si on tape un €, cela crée un bug 5 ici :

Private Sub textMonétaire_keypress(ByVal KeyAscii As MSForms.ReturnInteger): KeyAscii = IIf(Not Chr(KeyAscii) Like "[0-9€.]", 0, KeyAscii): End Sub

- J'ai bien essayé d'interdire toute les touches (par un autre code) mais à l'appui de Alt-GR et E (-> €), le bug apparait quand même.
- J'ai essayé de transformer la ligne de code citée plus haut mais sans succès.
- Vous me direz, tu n'as qu'à pas mettre le sigle €. Oui c'est vrai mais la première fois je l'ai fait machinalement du coup ça peut se reproduire.

vgendron a trouvé la solution avec son code :

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

En effet grâce à cela le sigle € apparait dès qu'on tape un chiffre... Moins de risque d'erreur du coup.

Sauf que c'est justement ce bout de code qu'on a commenté pour pouvoir régler le problème de résultat négatif dans la case "Doit".

Donc pour l'instant je dois choisir entre deux problèmes : soit risquer de mettre un € par erreur dans la txt_paiement , soit me retrouver avec un bug lorsque le TOTAL est inférieur au paiement.

 

[patricktoulon]

re

Private Sub textMonétaire_keypress(ByVal KeyAscii As MSForms.ReturnInteger)
If Len(textMonétaire) = 0 And Chr(KeyAscii) = "€" Then KeyAscii = 0: Exit Sub
KeyAscii = IIf(Not Chr(KeyAscii) Like "[0-9€.]", 0, KeyAscii)
End Sub

 

[Clemee61]

Sauf si je m'en sert mal, ta partie de code ne permet pas d'éviter le message d'erreur lorsqu'on tape "€" ni d'ajouter un € dans la txt_paiement.
En revanche les calculs s'effectuent bien même en cas de résultat négatif.

 

[patricktoulon]

non ca t’empêche seulement de taper € au début ce qui est amplement suffisant
maintenant entre nous ca commence a devenir un peu usine a gaz tes textbox
les euros on s'en fou c'est dans les cellules qui la limite est important
tu t'ennuierais beaucoup moins sans
surtout que tu interprète mal visiblement ce que c'est sensé faire

 

[Clemee61]

ok ok, j'arrête de vous ennuyer

 

[patricktoulon]

re
tu ne m'ennuie pas du tout
je te dis seulement que la simplicité pour un montage est préférable au départ
ce genre d'arrangement format etc... ca peut se faire après

 

[ChTi160]

Bonsoir le Fil
Souvent , j'ajoute un label a droite des textbox monétaires , qui contient le symbole de la monnaie ici : "€"
Ça évite tout ces problèmes de saisie , de calcul etc .
Bonne fin de soirée
Jean marie

 

[Clemee61]

 

[Clemee61]

Si j'ennuie pas (ou pas trop), ça me démange de trop pour ne pas vous demander encore de l'aide... Mais pour une tout autre partie

Dans les listes d'appel, les noms et autres renseignements doivent apparaitre sous deux conditions :
- L'enfant est dans une certaine fourchette d'âge
- La date indiquée en haut de la liste (case A2 pur moi) est comprise entre la date de début de séjour et la date de fin de séjour.

vgendron a géré le premier critère avec le code suivant :

NomFeuille = "Feuil_groupe_" & NomCat
    With Sheets("Données_ref").ListObjects("t_Catégories") 'selon la catégorie, on cherche les ages min et max qui serviront pour le filtre
        Set trouve = .ListColumns("Catégorie").Range.Find(NomCat, lookat:=xlWhole)
        AgeMin = trouve.Offset(0, 1)
        AgeMax = trouve.Offset(0, 2)
    End With
    
    With Sheets("Inscriptions").ListObjects("t_Inscriptions") 'on applique le filtre
        .Range.AutoFilter Field:=11, Criteria1:=">=" & AgeMin, Operator:=xlAnd, Criteria2:="<" & AgeMax
        On Error GoTo fin 'dans le cas ou le filtre ne donne aucune ligne
        Set zoneToCopy = .DataBodyRange.SpecialCells(xlCellTypeVisible)
        
    End With

Comme je ne suis pas à l'aise avec le With...End With, je n'ai pas résussi à adapter le code. J'ai essayé avec une condition If...End If mais sans plus de succès.

Pouvez vous m'aider encore ?