====== Correction visual basic ====== '---- Public Function Bonjour() bonjour = "Bonjour le monde" End Function Sub testBonjour() Dim texte As String texte = Bonjour() MsgBox texte, vbInformation, "testBonjour" End Sub '---- Sub color_poussin() Dim cel As Range 'range représente une cellule ou un groupe de cellules Dim i As Integer Dim dateN As Date 'parcourir la sélection de l'utilisateur For Each cel In Selection 'pour chaque cellule de la sélection If cel.Column = 6 Then 'colonne des dates de naisance dateN = cel.Text 'mémoriser la date de la cellule ds dateN annéeN = Year(dateN) 'extraire l'année If annéeN >= 1991 And annéeN <= 1992 Then cel.Font.Color = vbRed 'colorier en rouge la date End If End If Next End Sub Sub color_poussin2() Dim cel As Range 'range représente une cellule ou un groupe de cellules Dim i As Integer Dim dateN As Date 'parcourir la sélection de l'utilisateur For Each cel In Selection 'pour chaque cellule de la sélection If cel.Column = 6 Then 'colonne des dates de naisance dateN = cel.Text 'mémoriser la date de la cellule ds dateN annéeN = Year(dateN) 'extraire l'année If annéeN >= 1991 And annéeN <= 1992 Then cel.Font.Color = vbRed 'colorier en rouge la cellule celNom = "C" & cel.Row 'construit l'adresse de la cellule B2 si cel.Row vaut 2 Range(celNom).Font.Color = vbRed 'colorier le nom End If End If Next End Sub '---- Function nbCmp(cels As Range, valCmp) 'cels est la plage de cellule 'valCmp est la chaine recherchée Dim cel As Range Dim valC As String nbCmp = 0 valC = valCmp If TypeName(valC) <> "String" Then valC = LTrim(CStr(valC)) End If lg = Len(valC) For Each cel In cels If Mid(cel.Text, 1, lg) = valC Then 'on compare la même longueur de car. nbCmp = nbCmp + 1 End If Next End Function '---- Function extCar(cel, nb) extCar = Mid(cel, 1, 2) End Function '---- Sub Horloge() Application.OnTime Now + TimeValue("00:00:01"), "Horloge" Range("A10") = Time End Sub '---- Sub joyeux_anniversaire() Dim cel As Range 'range représente une cellule ou un groupe de cellules Dim i As Integer Dim dateN As Date Dim dateJ As Date 'parcourir la sélection de l'utilisateur dateJ = Date nb = 0 For Each cel In Selection 'pour chaque cellule de la sélection If cel.Column = 6 Then 'colonne des dates de naisance dateN = cel.Text 'mémoriser la date de la cellule ds dateN moisN = Month(dateN) jourN = Day(dateN) If moisN = Month(dateJ) And jourN = Day(dateJ) Then celNom = "C" & cel.Row 'construit l'adresse de la cellule B2 si cel.Row vaut 2 nom = Range(celNom).Text MsgBox nom, vbInformation, "Anniverssaire" nb = nb + 1 End If End If Next If nb = 0 Then MsgBox "pas d'anniversaire aujourd'hui!", vbInformation, "Anniverssaire" End Sub '---- Sub déplacer_vertical() Static cell_en_cours As String Const cell_deb = "A1" Const cell_fin = "A21" If cell_en_cours = "" Or Range(cell_deb) <> "" Then cell_en_cours = cell_deb 'la 1ère fois ou à chaque réinitialisation de A1 End If cell_effacer = cell_en_cours cell_en_cours = Mid(cell_en_cours, 1, 1) & (CInt(Mid(cell_en_cours, 2)) + 1) If cell_en_cours <> cell_fin Then Application.OnTime Now + TimeValue("00:00:01"), "déplacer_vertical" Range(cell_en_cours) = Range(cell_effacer) Range(cell_effacer) = "" End If End Sub '---- Function ageJoueur(cel As Range) Dim dateN As Date Dim dateJ As Date dateN = cel.Text dateJ = Date nb = Year(dateJ) - Year(dateN) If Month(dateJ) < Month(dateN) Then nb = nb - 1 ageJoueur = nb End Function '---- Function ageMoyen(cels As Range) Dim cel As Range Dim nb As Double Dim cumulA As Double nb = 0 cumulA = 0 For Each cel In cels nb = nb + 1 cumulA = cumulA + ageJoueur(cel) Next If nb > 0 Then ageMoyen = CInt(cumulA / nb) Else ageMoyen = 0 End If End Function