Liste déroulante de sélection multiple dans Excel

Question

J'ai un classeur avec de nombreuses feuilles (plus de 50). Dans 49 feuilles, il y a plus ou moins de listes déroulantes dans la colonne E. S'il existe une liste déroulante, la source de la liste dépend de la cellule C de la même ligne. Donc, en fonction par exemple. C11, E11 sera la liste déroulante1, la liste déroulante2 ou vide. Maintenant, dans chacune des 49 feuilles, je veux faire de la liste déroulante globale2 une liste de sélection multiple. Voici mon code:

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    
     If Not Sh.Name = "Dane" Then
        With Sh
            Dim Oldvalue As String
            Dim Newvalue As String
            .Protect UserInterfaceOnly:=True
            Application.EnableEvents = True
            On Error GoTo Exitsub
            ' the check to catch a change of single cell only
            If Not Target.Rows.Count > 1 And Target.Columns.Count > 1 Then
                ' check that this cell in column "E" (concept #2)
                If Not Intersect(Target, .Columns(5)) Is Nothing Then
                    'check if this is validation data cell
                    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 = Oldvalue & ", " & Newvalue
                            Else:
                              Target.Value = Oldvalue
                            End If
                        End If
                     End If
                End If
            End If
            Application.EnableEvents = True
        End With
    End If
    
Exitsub:
    Application.EnableEvents = True
    
End Sub 

Maintenant, si ce code est dans This_workbook, il semble ne pas fonctionner, et si je mets ce qui est ci-dessous dans une feuille spécifique vba, Worksheet_Changecela fonctionne. De plus, pour l'instant, ce code fonctionnera pour les deux, dropdownlist1 et dropdownlist2. Comment puis-je résoudre ce problème?

Answer 1

Donc, dans mon code était une erreur. Tout le temps, je faisais référence à une seule cellule, qui était vérifiée par: If Not Target.Rows.Count > 1 And Target.Columns.Count > 1 Thenmais après l'opérateur Et Pas manquait. De cette façon, pour fonctionner, je devrais modifier plus d'une cellule dans des colonnes séparées. Le code ci-dessous est fixe.

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    
     If Not Sh.Name = "Dane" Then
        With Sh
            Dim Oldvalue As String
            Dim Newvalue As String
            .Protect UserInterfaceOnly:=True
            Application.EnableEvents = True
            On Error GoTo Exitsub
            ' the check to catch a change of single cell only
            If Not Target.Rows.Count > 1 And Not Target.Columns.Count > 1 Then
                ' check that this cell in column "E" (concept #2)
                If Not Intersect(Target, .Columns(5)) Is Nothing Then
                    'check if this is validation data cell
                    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 = Oldvalue & ", " & Newvalue
                            Else:
                              Target.Value = Oldvalue
                            End If
                        End If
                     End If
                End If
            End If
            Application.EnableEvents = True
        End With
    End If
    
Exitsub:
    Application.EnableEvents = True
    
End Sub