Microsoft 365 Listes déroulantes multi-sélections et feuilles protégées.

  • Initiateur de la discussion Initiateur de la discussion selkis
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

selkis

XLDnaute Nouveau
Bonjour à tous,
Etant totalement novice dans tout ce qui touche aux macro et au VBA, je m'essaye à certaine chose et rencontre souvent pas mal de soucis 😉
Mon soucis actuel :
J'ai trouvé la solution suivante afin de pouvoir créer des listes déroulantes multi-sélections sur Excel.
Une fois ce code appliqué, tout fonctionne parfaitement bien jusqu'au moment où je choisi de protéger ma feuille contre certaines modifications.
En fait j'ai certaines de mes plages de cellule déverrouillées (clic droit, format cellule, protection, verrouillée décoché).
Ensuite je vais dans révision, protéger la feuille, sélectionner les cellules déverrouillées cochée.
Je valide.
Une fois la feuille protégée, je peux accéder à mes listes, mais je ne peux pas faire de sélection multiple; seulement un seul choix.
Quelqu'un connaitrait il une solution autre ou alors faut il modifier le code ci dessous ?
Dans ce dernier cas, que mettre ?
Merci pour vos retours.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Not Intersect(Target, Range("C5")) Is Nothing Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue & ", ") > 0 Then

Target.Value = Replace(Oldvalue, Newvalue & ", ", "")
ElseIf InStr(1, Oldvalue, ", " & Newvalue) > 0 Then

Target.Value = Replace(Oldvalue, ", " & Newvalue, "")
ElseIf InStr(1, Oldvalue, Newvalue) = 0 Then

Target.Value = Oldvalue & ", " & Newvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub
 
Solution
Bonsoir

En rajoutant ActiveSheet.Unprotect au début et ActiveSheet.Protect à la fin peut-être

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
    Dim Oldvalue As String
    Dim Newvalue As String
    Application.EnableEvents = True
    On Error GoTo Exitsub
    If Not Intersect(Target, Range("J10:J11")) Is Nothing Then
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            GoTo Exitsub
        Else: If Target.Value = "" Then GoTo Exitsub Else
            Application.EnableEvents = False
            Newvalue = Target.Value
            Application.Undo
            Oldvalue = Target.Value
            If Oldvalue = "" Then
                Target.Value = Newvalue
            Else...
Bonsoir

En rajoutant ActiveSheet.Unprotect au début et ActiveSheet.Protect à la fin peut-être

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
    Dim Oldvalue As String
    Dim Newvalue As String
    Application.EnableEvents = True
    On Error GoTo Exitsub
    If Not Intersect(Target, Range("J10:J11")) Is Nothing Then
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            GoTo Exitsub
        Else: If Target.Value = "" Then GoTo Exitsub Else
            Application.EnableEvents = False
            Newvalue = Target.Value
            Application.Undo
            Oldvalue = Target.Value
            If Oldvalue = "" Then
                Target.Value = Newvalue
            Else
                If InStr(1, Oldvalue, Newvalue & ", ") > 0 Then
                  
                    Target.Value = Replace(Oldvalue, Newvalue & ", ", "")
                ElseIf InStr(1, Oldvalue, ", " & Newvalue) > 0 Then
                  
                    Target.Value = Replace(Oldvalue, ", " & Newvalue, "")
                ElseIf InStr(1, Oldvalue, Newvalue) = 0 Then
                    
                    Target.Value = Oldvalue & ", " & Newvalue
                End If
            End If
        End If
    End If
    Application.EnableEvents = True
Exitsub:
    Application.EnableEvents = True
    ActiveSheet.Protect
End Sub

Slts
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
479
Réponses
4
Affichages
243
Réponses
3
Affichages
508
Retour