VBA : Calculer votre horoscope

Pas d’article depuis début Juillet ! Il est temps de se remettre au travail ; mais comme la période est encore estivale, je vous propose un petit jeu destiné au calcul de son horoscope solaire. De quoi se familiariser avec les fonctions dates d’Excel.

- 1 – Ouvrez un nouveau classeur et réalisez le tableau suivant, puis ajouter le bouton de commande Développeur / Contrôles / Insérer / contrôles de formulaire

- 2 – Réaliser un formulaire VBA (TestDate) conforme au modèle ci dessous

- 3 – Affecter la macro OuvrirFormulaire() (que vous avez saisie dans une feuille de module de code) au bouton de commande de votre feuille de calcul.

- 4 – Voici le code de cette macro…

Option Explicit

Sub OuvrirFormulaire()
With TestDate
.age.Caption = ""
.journaissance.Caption = ""
.Signe.Caption = ""
.datenaissance.Value = ""
End With
TestDate.Show
End Sub

- 5 – Le programme affiche en permanence la date et l’heure courante. Il faut saisir sa date de naissance puis cliquer sur le bouton OK. Excel retourne alors votre âge, votre jour de naissance et votre signe de l’horoscope solaire dans 3 labels différents

- 6 – Voici le code du programme :

Option Explicit

'indique que les tableaux sont numérotés à partir d'un indice i=1
Option Base 1

‘************************************************
Private Sub CalcAge_Click()
'déclaration des variables
Dim dn As Date
Dim dj As Date
Dim dateSigne As Date
Dim NumJourSemaine As Byte
Dim JourSemaine As String
Dim ligne As Byte
Dim TableJourSemaine

'*****************************************
'Calcul et affichage de l'âge avec arrondi
dj = Date
dn = datenaissance.Value
age.Caption = "Vous avez " & Int((dj - dn) / 365.25) & " ans."

'*****************************************
'Calcul et affichage du jour de naissance
‘remplissage du tableau des jours de la semaine
TableJourSemaine = Array("Dimanche", "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi")
‘Weekday(n) retourne le n° d’ordre du jour dans la semaine
NumJourSemaine = Weekday(dn)
‘en fonction du numéro d’ordre le selon que va nous donner le jour
Select Case NumJourSemaine
Case 1
JourSemaine = TableJourSemaine(1)
Case 2
JourSemaine = TableJourSemaine(2)
Case 3
JourSemaine = TableJourSemaine(3)
Case 4
JourSemaine = TableJourSemaine(4)
Case 5
JourSemaine = TableJourSemaine(5)
Case 6
JourSemaine = TableJourSemaine(6)
Case 7
JourSemaine = TableJourSemaine(7)
End Select
journaissance.Caption = "Vous êtes né un " & JourSemaine & "."

'***********************************************************
'calcul et affichage de l'horoscope solaire
ligne = 2
‘il faut transformer la date saisie en une date d’année type, 2009 par exemple car le tableau du classeur correspond à une seule année
dateSigne = CDate(Left(CStr(datenaissance.Value), 6) & "2009")
While ligne >= 2 And ligne <= 13 If dateSigne >= Cells(ligne, 2).Value And dateSigne <= Cells(ligne, 3).Value Then Signe.Caption = "Vous êtes du " & Cells(ligne, 1).Value & " dans l'horoscope solaire."
Exit Sub
Else
‘il faut bloquer le passage à l’année suivante
If dateSigne >= 22 / 12 / 2009 Or dateSigne <= 20 / 1 / 2009 Then Signe.Caption = "Vous êtes du Capricorne dans l'horoscope solaire."
End If
ligne = ligne + 1
End If
Wend
End Sub

‘******************************************************
Private Sub Sortir_Click()
'fermeture du formulaire
TestDate.Hide
End Sub

‘********************************************************
Private Sub UserForm_Activate()
'affichage de la date et de l'heure courante
datejour.Caption = "Aujourd'hui : " & Date & " à " & Time
End Sub

Partager |