Ce code sert à savoir, rien qu'en indiquant une date : le nombre de jours passés depuis cette date jusqu'à maintenant, le jour de la semaine (lundi, mardi...) de cette date (peut-être bien utile!) ainsi que le signe du zodiaque d'une personne née ce jour-ci.
Pour le bon fonctionnement de l'application il faut placer : une Listbox avec les nombres de 1 a 31 nommée j, une autre nommée m avec les nombres de 1 a 12 et une autre nommée a (son contenu sera décrit dans une boucle); 6 contrôle Label : une avec le titre de l'application (mise en haut) nommée questage, 2 placées entre les 3 Listbox avec juste un "/" (nommés slash1 et slash2), un en dessous des 3 Listbox où il est écrit "Quand tu as fini, cliques ici!" nommée conc, un autre en dessous avec écrit "Et ici!" nommée conc2 et un autre encore en dessous nommée conc3 et où il est écrit "Et ici!". Enfin 3 boutons en bas, un nommé ok où il est écrit "OK", un autre à droite où il est écrit "Quitter" et nommée quitter et un autre nommé rens et où c'est écrit "renseignements". Si vous voulez changer des textes, même le texte style "quand tu as fini, cliques ici!" il faudra changer le code correspondant!!!!
Il y a le code de la form + le module
Source / Exemple :
'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
Conclusion :
Bon me suis rendu compte qu'une fonction specifique donnait le jour de la semaine mais au moins la on voit comment c'est codé ;-) !
Dans la MàJ, j'ai inseré un module : le code est donc beaucoup + clair.
Voila et n'hésitez pas a noter et à laisser vos commentaires!
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.