APs et stages du BTS SIO du lycée Suzanne Valadon

Cette page est en lecture seule. Vous pouvez afficher le texte source, mais ne pourrez pas le modifier. Contactez votre administrateur si vous pensez qu'il s'agit d'une erreur.
====== Correction visual basic ======
<code vbnet>
'---- 
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
</code>