1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
   | 
Private Sub AssignerListeGroupe(prmCell As Range)
    Application.Volatile: 'Force Excel à recaclcuer les célulles qui utilise cette procédure
    Dim nomListe As String
    
    Select Case prmCell
        Case "I"
            nomListe = "ListeGroupeInitiation"
            
        Case "R"
            nomListe = "ListeGroupeRecreation"
            
        Case "C"
            nomListe = "ListeGroupeCompetition"
            
        Case "P"
            nomListe = "ListeGroupePerfectionnement"
            
        Case ""
            Call DesassignerUneListeDeValidation(Cells(prmCell.Row, DONNEES_COLONNE_GROUPE))
            Cells(prmCell.Row, DONNEES_COLONNE_GROUPE).ClearContents
            
        Case Else
            MsgBox "Le niveau ne peut être que I, R, C ou P", vbCritical
    End Select
    
    If nomListe <> "" Then
        Call AssignerUneListeDeValidation(Cells(prmCell.Row, DONNEES_COLONNE_GROUPE), nomListe)
    End If
    
End Sub
Public Sub DeprotegerFeuille()
    Me.Unprotect
End Sub
Public Sub ProtegerFeuille()
    Call Me.Protect(contents:=True, _
                    AllowInsertingRows:=True, _
                    AllowDeletingRows:=True, _
                    AllowSorting:=True, _
                    AllowFiltering:=True)
End Sub
Private Sub AssignerUneListeDeValidation(prmCell As Range, prmNomListeValidation As String)
    Call DeprotegerFeuille
    
    With prmCell.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
             Operator:=xlBetween, Formula1:="=" & prmNomListeValidation
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = "Erreur"
        .InputMessage = ""
        .ErrorMessage = "Seules les valeurs affichées dans la liste sont acceptées."
        .ShowInput = True
        .ShowError = True
    End With
    Call ProtegerFeuille
End Sub
Private Sub DesassignerUneListeDeValidation(prmCell As Range)
    With prmCell.Validation
        .Delete
    End With
End Sub | 
Partager