GRÂCE À UNE DATE : NOMBRES DE JOURS PASSÉS DEPUIS CETTE DATE, SIGNE DU ZODIAQUE, JOUR DE LA SEMAINE (LUNDI...)

'Code de la form

'________________________________________________________________________

Private Sub a_Click()
ageannee = 2001 - a.Text    'ageannee = nbr d'années
    Call couleur(&HC0FFC0)  'on appel la procédure du module pour changer la couleur dec controles
ageanneebiss = 0    'Le programme compte le nombre de jours (à cause des années bissextiles) à rajouter depuis que la personne est né (après février, sinon il faudrait compter un jour en plus)
boucle = 2000   'On utilise une boucle : quelle que soit la date de mise, on comptera toujours les années bissextiles
nbrannee = a.Text   'Sert tout simplement pour la boucle
    Do  'Utilisation de la boucle Do...Loop Until
        boucle = (boucle - 4)
        ageanneebiss = ageanneebiss + 1 'ageanneebiss correspond au nombre d'année bissextiles passées
    Loop Until (boucle <= nbrannee)
If nbrannee >= 2001 Then
    ageanneebiss = 0
End If
End Sub
Private Sub conc2_Click()   'évenements se produisant lors du clic sur la 2ème conclusion (celle qui dit le jour de naissance (ex : lundi...))
    Call couleur(&HFFFFFF)
sem = 0 'Déclare le nombre de semaines vécus (avant la boucle) à 0
varbouclesem = 0    'Sert pour la boucle - nbr intermediaire
joursem = (ageannee * 365) + (agemois * 30) + agejours + ageanneebiss + joursplus + agemoislong + avfev 'Cette variable sert à la boucle. Elle est presque identique que agefinal, mais elle dit le nombre de jours comme si l'on était le 31/12/2001 ------- agemois = nbr de mois; agejours = nbr de jours; joursplus = jours à rajouter lorsque l'on fait 30-x alors qu'il faudrait faire 31-x; avfev = jours à rajouter (à cause des années bissextiles) quand la personne est née avant février; agemoislong = jours à rajouter en comptant dans mois les autres mois qui ne sont pas de 30 jours
    Do  'Commencement de la boucle des jours de la semaine
        varbouclesem = varbouclesem + 7   'varbouclesem prend 7 jours...
        sem = sem + 1   'Donc on compte une semaine de plus
        difference = (sem * 7) - joursem    'difference est un nbr intermediaire
    Loop Until (varbouclesem >= joursem)   'La boucle s'arrête quand autre dépasse le nombre de jours
Call sub_selectcase_joursem_et_difference
If conc <> "Quand tu as fini, cliques ici!" And conc <> "Ce n'est pas possible." And conc <> "Remplis toutes les cases!" Then 'Si toutes les cases sont remplies, une boîte de dialoque indique le nombre d'heures de vie de la personne
    conc2.Caption = "Tu es né un " & joursdelasemaine & "."
Else
    conc2.Caption = "Et ici!"
End If
End Sub
Private Sub conc3_Click()   'évenement se produisant lors du clic sur la 3ème conclusion (celle qui dit le signe du zodiaque)
Call couleur(&HFFFFC0)
If conc = "Quand tu as fini, cliques ici!" Or conc = "Ce n'est pas possible." Or conc = "Remplis toutes les cases!" Or conc2 = "Et ici!" Then
    conc3 = "Et ici!"
Else
    conc3.Caption = "Ton signe du zodiaque est : " & signezodiaque & "."   'Dis ce qu'affiche la conclusion des signes du zodiaques.
    autrejours = j.Text 'Sert juste pour les signes du zodiaque
    autremois = m.Text - 1  'Sert juste pour les signes du zodiaque; dans autremois il faut enlever 1 sinon, par exemple, le 1/1 ferait 31 jours. Il faut donc enlever 1 mois : cela donne 1 jour.
    agezodiaque = (autremois * 30) + autrejours + agemoislongzod    'Donne le calcul à faire qui donnera le signe du zodiaque.
End If
    Select Case m   'Compte le nombre de jours à rajouter car tous les mois ne font pas 30 jours. Ex: si je choisi mars, janvier et février seron comptés comme mois de 30 jours; il faut donc enlever 1 jour car 28 + 31 <> 60 il faut donc faire : 28 + 31 = 60 - 1
        Case Is = 12    'Faut s'accrocher, je sais mais c'est comme ça
            agemoislongzod = 4
        Case Is = 11
            agemoislongzod = 4
        Case Is = 10
            agemoislongzod = 3
        Case Is = 9
            agemoislongzod = 3
        Case Is = 8
            agemoislongzod = 2
        Case Is = 7
            agemoislongzod = 1
        Case Is = 6
            agemoislongzod = 1
        Case Is = 5
            agemoislongzod = 0
        Case Is = 4
            agemoislongzod = 0
        Case Is = 3
            agemoislongzod = -1
        Case Is = 2
            agemoislongzod = 1
        Case Is = 1
            agemoislongzod = 0
    End Select
Select Case agezodiaque
    Case Is >= 355
        signezodiaque = "Capricorne"
    Case Is >= 325
        signezodiaque = "Sagittaire"
    Case Is >= 296
        signezodiaque = "Scorpion"
    Case Is >= 265
        signezodiaque = "Balance"
    Case Is >= 234
        signezodiaque = "Vierge"
    Case Is >= 203
        signezodiaque = "Lion"
    Case Is >= 172
        signezodiaque = "Cancer"
    Case Is >= 140
        signezodiaque = "Gémaux"
    Case Is >= 109
        signezodiaque = "Taureau"
    Case Is >= 79
        signezodiaque = "Bélier"
    Case Is >= 49
        signezodiaque = "Poissons"
    Case Is >= 19
        signezodiaque = "Verseau"
    Case Is >= 1
        signezodiaque = "Capricorne"
End Select
    If conc = "Quand tu as fini, cliques ici!" Or conc = "Ce n'est pas possible." Or conc = "Remplis toutes les cases!" Or conc2 = "Et ici!" Then
        conc3 = "Et ici!"
    Else
        conc3.Caption = "Ton signe du zodiaque est : " & signezodiaque & "."   'Dis ce qu'affiche la conclusion des signes du zodiaques.
        autrejours = j.Text
        autremois = m.Text - 1  'Dans autremois il faut enlever 1 sinon, par exemple, le 1/1 ferait 31 jours. Il faut donc enlever 1 mois : cela donne 1 jour.
        agezodiaque = (autremois * 30) + autrejours + agemoislongzod    'Donne le calcul à faire qui donnera le signe du zodiaque.
    End If
End Sub
Private Sub Form_Load() 'Se produit au chargement du programme
nbra = 2002 'Grace a une boucle, l'ordi met tous les nombre de 1700 à 2002 dans la liste de "année"
    Do
        a.AddItem (nbra)
        nbra = nbra - 1
    Loop Until (nbra < 1900)
Select Case Format(Month(Date))   'Compte le nombre de jours à rajouter car tous les mois ne font pas 30 jours. Ex: si je choisi mars, janvier et février seron comptés comme mois de 30 jours; il faut donc enlever 1 jour car 28 + 31 <> 60 il faut donc faire : 28 + 31 = 60 - 1
    Case Is = 12
        joursarajenplus = 4
    Case Is = 11
        joursarajenplus = 4
    Case Is = 10
        joursarajenplus = 3
    Case Is = 9
        joursarajenplus = 3
    Case Is = 8
        joursarajenplus = 2
    Case Is = 7
        joursarajenplus = 1
    Case Is = 6
        joursarajenplus = 1
    Case Is = 5
        joursarajenplus = 0
    Case Is = 4
        joursarajenplus = 0
    Case Is = 3
        joursarajenplus = -1
    Case Is = 2
        joursarajenplus = 1
    Case Is = 1
        joursarajenplus = 0
End Select
    joursaraj = ((Format(Month(Date)) - 1) * 30) + Format(Day(Date)) + joursarajenplus  'Grâce à cette expressions, on est plus obligé d'actualiser chaque jour le programme pour rajouter les jours de l'année
End Sub
Private Sub j_Click()   'évenement se produisant lors du clic sur la liste des jours
agejours = 30 - j.Text
Call couleur(&HFFC0C0)
End Sub
Private Sub m_click()
Call couleur(&HC0FFFF)
conc3.BackColor = &HC0FFFF
Select Case m   'Compte le nombre de jours à rajouter car tous les mois ne font pas 30 jours. Ex: si je choisi mars, janvier et février seron comptés comme mois de 30 jours; il faut donc enlever 1 jour car 28 + 31 <> 60 il faut donc faire : 28 + 31 = 60 - 1
    Case 12    'Compte le nombre de jours à rajouter car tous les mois ne font pas 30 jours. Ex: si je choisi octobre, novembre et décembre seron comptés comme mois de 30 jours; il faut donc rajouter 1 jours car décembre fait 31 jours et non pas 30 jours
        agemoislongzod = 4   'Compte le nombre de jours (1 ou -2 pour février) à rajouter lorsque le mois tapé ne fait pas 30 jours
        agemoislong = 0
        joursplus = 1
    Case 11
        agemoislongzod = 4
        agemoislong = 1
        joursplus = 0
    Case 10
        agemoislongzod = 3
        agemoislong = 1
        joursplus = 1
    Case 9
        agemoislongzod = 3
        agemoislong = 2
        joursplus = 0
    Case 8
        agemoislongzod = 2
        agemoislong = 2
        joursplus = 1
    Case 7
        agemoislongzod = 1
        agemoislong = 3
        joursplus = 1
    Case 6
        agemoislongzod = 1
        agemoislong = 4
        joursplus = 0
    Case 5
        agemoislongzod = 0
        agemoislong = 4
        joursplus = 1
    Case 4
        agemoislongzod = 0
        agemoislong = 5
        joursplus = 0
    Case 3
        agemoislongzod = -1
        agemoislong = 5
        joursplus = 1
    Case 2
        agemoislongzod = 1
        agemoislong = 6
        joursplus = -2
    Case 1
        agemoislongzod = 0
        agemoislong = 4
        joursplus = 1
End Select
agemois = 12 - m.Text
avfev = IIf(m <= 2, 1, 0)   'Il faut que avfev soit égale à 1 car la personne est né avant février donc il faudra compter 1 jour d'année bissextiles en plus
End Sub
Private Sub ok_Click()  'Quand l'utilisateur clique sur OK, le programme indique le nombre d'heures vécues
    If conc <> "Quand tu as fini, cliques ici!" And conc <> "Remplis toutes les cases!" And conc2 <> "Et ici!" And conc3 <> "Et ici!" Then    'Si toutes les cases sont remplies, une boîte de dialoque indique le nombre d'heures de vie de la personne
        intpress1 = MsgBox("Au revoir, la personne aux " & agefinal & " jours de vie et aux " & heures & " heures de bonheur!", vbOKOnly, "A +")
    Else    'Si il y a une case non remplie, message d'erreur
        intpress = MsgBox("Rempli correctement les cases!", vbOKOnly, "Erreur...")
    End If
If intpress1 = vbOK Then End   'Si l'utilisateur clique sur OK, le programme s'arrête
End Sub
Private Sub quitter_Click()
    End 'Met fin au programme
End Sub
Private Sub rens_Click()
    renseignements = MsgBox("Fait par Clément Debin, à Carquefou (en Loire-Atlantique), en mars 2002 (mis sur VB France en novembre 2002). Pour m'écrire (n'hésitez pas!) : debin.clement@free.fr. Merci. A+", vbOKOnly, "Renseignements") 'Donne quelques renseignements
End Sub
Private Sub conc_Click()    'évenement se produisant lors du clic sur la 1ère conclusion (celle qui indique le nombre de jours vécus)
Call couleur(&H80C0FF)
sem = 0 'Déclare le nombre de semaines vécus (avant la boucle) à 0
varbouclesem = 0   'Déclare autre (avant la boucle) à 0
joursem = (ageannee * 365) + (agemois * 30) + agejours + ageanneebiss + joursplus + agemoislong + avfev 'Cette variable sert à la boucle. Elle est presque identique que agefinal, mais elle dit le nombre de jours comme si l'on était le 31/12/2001
Do  'Commencement de la boucle des jours de la semaine
    varbouclesem = varbouclesem + 7   'varbouclesem prend 7 jours...
    sem = sem + 1   'Donc on compte une semaine de plus
    difference = (sem * 7) - joursem
Loop Until (varbouclesem >= joursem)   'La boucle s'arrête quand autre dépasse le nombre de jours
Call sub_selectcase_joursem_et_difference
    If j.Text <> "" And m.Text <> "" And a.Text <> "" Then 'Si toutes les cases sont remplies, une boîte de dialoque indique le nombre d'heures de vie de la personne
        ageannee = 2001 - a.Text
        agemois = 12 - m.Text
        agejours = 30 - j.Text
        agefinal = (ageannee * 365) + (agemois * 30) + agejours + ageanneebiss + joursplus + agemoislong + avfev + joursaraj  'Donne le calcul final à faire. Cette expression est placée ici car sinon, on est oblige de cliquer sur la conclusion pour avoir le bon jour de naissance.
        conc.Caption = "Tu as vecu " & agefinal & " jours jusqu'à aujourd'hui." 'Ce qui s'affiche lorsque l'on clique sur conclusion
    Else
        conc = "Remplis toutes les cases!"
    End If
If agefinal <= 0 Then conc = "Ce n'est pas possible."   'Si agefinal est égal à 0 (c'est à dire qu'il y a des cases non remplies) alors message d'erreur.
heures = agefinal * 24
End Sub    

'________________________________________________________________________

'Module

'________________________________________________________________________

Public agefinal As Single, agemoislong As Single, ageannee As Single, agemois As Single, agejours As Single, joursplus As Single, avfev As Single, ageanneebiss As Single, nbrannee As Single, joursem As Single, varbouclesem As Single, sem As Single, difference As Single, joursdelasemaine As String, heures As Single, autremois As Single, agezodiaque As Single, autrejours As Single, agemoislongzod As Single, joursaraj As Single   'Déclare toutes les variables (elles sont toutes "Single")

Public Function couleur(colorvb As ColorConstants)  'Procédure pour changer de couleur
With age
    .BackColor = colorvb
    .questage.BackColor = colorvb
    .slash1.BackColor = colorvb
    .slash2.BackColor = colorvb
    .conc.BackColor = colorvb
    .conc2.BackColor = colorvb
    .conc3.BackColor = colorvb
End With
End Function

Public Sub sub_selectcase_joursem_et_difference()
    
Select Case difference  'Procédure pour savoir quel jour de la semaine, utilisée 2 fois dans le code de la form
    Case Is = 0
        joursdelasemaine = "Lundi"
    Case Is = 1
        joursdelasemaine = "Mardi"
    Case Is = 2
        joursdelasemaine = "Mercredi"
    Case Is = 3
        joursdelasemaine = "Jeudi"
    Case Is = 4
        joursdelasemaine = "Vendredi"
    Case Is = 5
        joursdelasemaine = "Samedi"
    Case Is = 6
        joursdelasemaine = "Dimanche"
End Select
    Select Case joursem
        Case Is = 0
            joursdelasemaine = "Lundi"
        Case Is = 1
            joursdelasemaine = "Dimanche"
        Case Is = 2
            joursdelasemaine = "Samedi"
        Case Is = 3
            joursdelasemaine = "Vendredi"
        Case Is = 4
            joursdelasemaine = "Jeudi"
        Case Is = 5
            joursdelasemaine = "Mercredi"
        Case Is = 6
            joursdelasemaine = "Mardi"
    End Select

End Sub

'Fin du code : Clément D / Mars 2002 / Carquefou (44) / debin.clement@free.fr OU Milo_44@msn.com

Télécharger le zip