XL 2016 calcul entre textbox

phil107 · 12 Février 2021

Bonjour je cherche de l'aide pour resoudre mon probleme
j'ai créé un formulaire dans lequel j'ai une textbox (TxtDateNaissance) , une seconde (TxtSaison) et une troisieme (TxtCategorie)
dans la TxtDateNaissance je rentre la date sous la forme jj/mm/yyyy (19/02/1967), dans la TxtSaison , la saison yyyy-yyyy (2020-2021) et je voudrais que dans la 3 eme TextBox (TxtCategorie) s'inscrive la categorie
si l'adherent à moins de 8 ans il est poussin
si l'adherent a entre 9 et 10 ans il est benjamin
si l'adherent a entre 11 et 12 ans il est Minime
si l'adherent a entre 13 et 14 ans il est Cadet
si l'adherent a entre 15 et 17 ans il est Junior
si l'adherent a entre 18 et 39 ans il est Senior
si l'adherent a40 et plus il est veteran
Merci pour votre aide

JM27 · 12 Février 2021

Bonjour
Il manque une info:
si Saison 2020-2021 par exemple.
le calcul doit se faire entre la date de naissance et quelle date dans la saison ???
cela serait bien de joindre un fichier anonymisé

phil107 · 12 Février 2021

Bonjour
par rapport à 2020
je vous joins le fichier

JM27 · 12 Février 2021

bonjour
date de naissance
par rapport
01/01/2020
ou 31/12/2020
???

JM27 · 12 Février 2021

A priori d'après google c'est le 31/12/2020
d'après Google

Catégories génériques internationales

Âge calculé au 31 décembre de l'année en cours

A mettre dans le module de l'userform

VB:

Private Sub TxtDateNaissance_AfterUpdate()
   If TxtDateNaissance <> "" And TxtSaison <> "" Then
        AnnéePersonne
    End If
End Sub
Private Sub TxtSaison_AfterUpdate()
     If TxtDateNaissance <> "" And TxtSaison <> "" Then
        AnnéePersonne
    End If
End Sub
Sub AnnéePersonne()
    If IsDate(TxtDateNaissance) = False Then
        MsgBox " La date de naissance n'est pas correcte"
        Exit Sub
    End If
    AnnéeRéférence = Left(TxtSaison, 4)
    datefin = "31/12/" & AnnéeRéférence
    If IsDate(datefin) = False Then
        MsgBox " La saison n'est pas saisie correctement"
        Exit Sub
    End If
     DateDébut = CDate(TxtDateNaissance)
     datefin = CDate(datefin)
    If Day(DateDébut) = Day(datefin) And Month(DateDébut) = Month(datefin) Then
        AnAdhérent = Year(datefin) - Year(DateDébut)
    ElseIf Day(DateDébut) = Day(datefin) And Month(DateDébut) < Month(datefin) Then
         AnAdhérent = Year(datefin) - Year(DateDébut)
    ElseIf Day(DateDébut) > Day(datefin) And Month(DateDébut) > Month(datefin) Then
         AnAdhérent = Year(datefin) - Year(DateDébut) - 1
    ElseIf Day(DateDébut) > Day(datefin) And Month(DateDébut) = Month(datefin) Then
        AnAdhérent = Year(datefin) - Year(DateDébut) - 1
    ElseIf Day(DateDébut) > Day(datefin) And Month(DateDébut) < Month(datefin) Then
        AnAdhérent = Year(datefin) - Year(DateDébut)
    ElseIf Day(DateDébut) <= Day(datefin) And Month(DateDébut) <= Month(datefin) Then
        AnAdhérent = Year(datefin) - Year(DateDébut)
    ElseIf Day(DateDébut) <= Day(datefin) And Month(DateDébut) > Month(datefin) Then
       AnAdhérent = Year(datefin) - Year(DateDébut) - 1
    End If
    Select Case AnAdhérent
        Case Is <= 8
            TxtCategorie = "Poussin"
        Case Is <= 10
            TxtCategorie = "Benjamin"
        Case Is <= 12
            TxtCategorie = "Minime"
        Case Is <= 14
            TxtCategorie = "Cadet"
        Case Is <= 17
            TxtCategorie = "Junior"
        Case Is <= 39
            TxtCategorie = "Senior"
        Case Is > 39
            TxtCategorie = "Veteran"
    End Select
End Sub

ChTi160 · 12 Février 2021

Bonjour
Bonjour le Fil (jean-Marcel)
Bonjour le Forum
Si tu travailles sur la saison en cours pourquoi ne mets tu pas la Saison a l'ouverture du Userform

VB:

Private Sub UserForm_Initialize()
With Me
   With .TxtSaison
        .Text = Year(Date) - 1 & "-" & Year(Date)
   End With
End With
End Sub

ca peut éviter le test si Vide de (TxtSaison)
tu pourrais ainsi remplacer le TextBox par un Label
jean marie

JM27 · 12 Février 2021

Bonjour
Salut Chti
Pour moi une saison commence en septembre de 2020
donc l'année sera 2020-2021
si tu travailles sur ton fichier en septembre de 2020 tu auras
2019-2020
je pensais à un déroulant au lieu d'un text box pour la saison ( ca éviterait bien des erreurs)

VB:

Private Sub UserForm_Initialize()
    For I = 2015 To 2030
        Me.ComboSaison.AddItem (I - 1 & "-" & I)
    Next
End Sub

Mais cela seul l'intéressé ( qui ne m'as pas répondu sur la date de référence post#4 ) pourra nous dire comment il fonctionne.

ChTi160 · 12 Février 2021

Re
merci JM
effectivement je n'ai pas pensé a ce problème !
merci
je mets quand même ce que j'ai mis pour simplifier

VB:

Private Sub UserForm_Initialize()
With Me
   With .LblSaison
             .Caption = Year(Date) - 1 & "-" & Year(Date)
             .Tag = DateSerial(Year(Date) - 1, 12, 31) 'On met la date de Fin dans le Tag du Control
   End With
   With .CbbSexe
            .List = Array(" ", "M", "F")
            .ListIndex = 0
    End With
End With
End Sub

Code:

Sub AnnéePersonne()
Dim StrCat$
    If IsDate(TxtDateNaissance) = False Then
        MsgBox " La date de naissance n'est pas correcte"
        TxtDateNaissance = ""
               Exit Sub
    End If
     datefin = CDate(LblSaison.Tag) 'On récupére la date
    If IsDate(datefin) = False Then
        MsgBox " La saison n'est pas saisie correctement"
        Exit Sub
    End If
     datedébut = CDate(TxtDateNaissance)
           datefin = CDate(datefin)
     AnAdhérent = DateDiff("yyyy", datedébut, datefin, vbMonday, vbFirstFourDays)
    Select Case AnAdhérent
        Case Is <= 8
            StrCat = "Poussin"
        Case Is <= 10
            StrCat = "Benjamin"
        Case Is <= 12
            StrCat = "Minime"
        Case Is <= 14
            StrCat = "Cadet"
        Case Is <= 17
            StrCat = "Junior"
        Case Is <= 39
            StrCat = "Senior"
        Case Is > 39
            StrCat = "Veteran"
    End Select
           TxtCategorie.Text = StrCat
End Sub

je vais attendre des nouvelles Lol
de quelle activité parle t'on ?????????????????
merci
jean marie

JM27 · 12 Février 2021

bonjour
Comme la date de fin est le 31/12 on doit pouvoir remplacer

VB:

 AnAdhérent = DateDiff("yyyy", datedébut, datefin, vbMonday, vbFirstFourDays)

par

Code:

AnAdhérent = Year(datefin) - Year(DateDébut)

a priori ça le fais

phil107 · 15 Février 2021

Desolé pour cette reponse tardive et deja un grand merci pour vos reponses . j ai bosse pour tout le week end . la saison commence donc en septembre . si j'inscrits dans les proprietes de la la textbox à Text "2020-2021". est ce que ca peut poser des problemes dans les calculs

JM27 · 15 Février 2021

Bonjour
Non ca ne pose pas de pb , mais quand tu passeras à l'année suivante il faudra à nouveau modifier

phil107 · 15 Février 2021

merci je ferai comme ca . par contre si je peux encore un peu abuser de ton aide . j aimerai pouvoir concatener la premiere lettre de la TxtCategorie et la premiere lettre de la TxtTypeLicence dans la TxtCodeLicence de maniere par la suite pouvoir indiquer le montant de la licence que l'on retrouve la feuille parametre
merci encore pour l'aide

JM27 · 15 Février 2021

bonjour
A rajouter

VB:

Private Sub TxtCategorie_Change()
    If Me.TxtCategorie <> "" And Me.TxtTypeLicence <> "" Then
        Me.TxtCodeLicence = Left(TxtCategorie, 1) & Left(TxtTypeLicence, 1)
    End If
End Sub
Private Sub TxtTypeLicence_Change()
    If Me.TxtCategorie <> "" And Me.TxtTypeLicence <> "" Then
        Me.TxtCodeLicence = Left(TxtCategorie, 1) & Left(TxtTypeLicence, 1)
    End If
End Sub

phil107 · 15 Février 2021

Encore merci pour tout. ca marche impeccable j'ai egalement regardé ta cave à vin. bravo c'est vraiment bien. je vais regardé si je peux l'adapté pour ma cave

JM27 · 15 Février 2021

bonjour
Attention à consommer avec modération !!!

XL 2016 calcul entre textbox

phil107

XLDnaute Nouveau

JM27

XLDnaute Barbatruc

phil107

XLDnaute Nouveau

Pièces jointes

JM27

XLDnaute Barbatruc

JM27

XLDnaute Barbatruc

Pièces jointes

ChTi160

XLDnaute Barbatruc

JM27

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

JM27

XLDnaute Barbatruc

phil107

XLDnaute Nouveau

JM27

XLDnaute Barbatruc

phil107

XLDnaute Nouveau

Pièces jointes

JM27

XLDnaute Barbatruc

phil107

XLDnaute Nouveau

JM27

XLDnaute Barbatruc

Discussions similaires