'---- 
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