validation de données via VBA + combobox en cascade

C

Cedric_C

XLDnaute Nouveau
Bonjour à tous,

Cela fait quelques jours que je coince donc autant demander conseil : c'est pourquoi je viens de m'inscrire sur votre site... :)

Avec un collègue, nous sommes en train de créer de toute pièce un fichier de pointage utilisable par une petite centaine d'employé sur notre réseau interne.

S'agissant d'un fichier à usage professionnel, je préfère d'abord tenter de vous expliquer sans envoyer de fichier joint.
Si cela est vraiment nécessaire, nous aviserons par la suite.

Dans ce tableau, nous avons inséré des Combo Box en cascade en colonne B, C et D. Ensuite, à partir de la Colonne H démarre une trentaine de colonnes qui forment un calendrier mensuel où chaque collaborateur ira encoder le nombre d'heures prestées.

En Colonne B, la Combo Box n°1 comprend les noms de services de notre entreprise (de construction pour info). Le choix du service donne accès, en colonne C, à certains noms de Chantiers dans la Combo Box 2. Enfin, le choix de ce chantier, donne l'accès, en Colonne D, à certaines tâches effectuées sur les-dits chantiers (Combo Box 3).

Cependant, certains chantiers n'ont aucune tâches spécifiques et donc il arrive que la Combo Box 3 soit vide.

Par contre, tant que les 3 Combo Box ne sont pas vides, nous aimerions imposer la sélection d'une donnée dans chacune d'elles avant que l'employé puisse insérer un nombre d'heures dans les colonnes du calendrier.

J'ai déjà trouvé une partie du code VBA à appliquer. Il bloque actuellement l'encodage tant que les cellules des colonnes B, C et D sont vides. Il me reste à insérer le critère qui dit que : si les combo box sont vides, il autorise l'encodage dans la case où il se trouve. Mais là, je bloque totalement !

J'ai déjà essayé avec If Combobox.listcount <> 0 then" ... mais cela ne marche pas. Pire ! Cela désactive même parfois les Combobox dans le tableau et je ne vois pas trop pourquoi d'ailleurs...

Bref, Voici le code que j'ai appliqué et que j'aimerais compléter suivant vos conseils :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 8 Then
    Application.EnableEvents = False
        If Target.Offset(0, -6) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -6).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -5) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -5).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -4) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -4).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 9 Then
    Application.EnableEvents = False
        If Target.Offset(0, -7) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -7).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -6) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -6).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -5) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -5).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 10 Then
    Application.EnableEvents = False
        If Target.Offset(0, -8) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -8).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -7) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -7).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -6) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -6).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 11 Then
    Application.EnableEvents = False
        If Target.Offset(0, -9) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -9).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -8) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -8).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -7) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -7).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 12 Then
    Application.EnableEvents = False
        If Target.Offset(0, -10) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -10).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -9) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -9).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -8) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -8).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 13 Then
    Application.EnableEvents = False
        If Target.Offset(0, -11) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -11).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -10) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -10).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -9) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -9).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 14 Then
    Application.EnableEvents = False
        If Target.Offset(0, -12) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -12).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -11) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -11).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -10) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -10).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 15 Then
    Application.EnableEvents = False
        If Target.Offset(0, -13) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -13).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -12) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -12).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -11) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -11).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 16 Then
    Application.EnableEvents = False
        If Target.Offset(0, -14) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -14).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -13) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -13).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -12) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -12).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 17 Then
    Application.EnableEvents = False
        If Target.Offset(0, -15) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -15).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -14) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -14).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -13) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -13).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 18 Then
    Application.EnableEvents = False
        If Target.Offset(0, -16) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -16).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -15) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -15).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -14) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -14).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 19 Then
    Application.EnableEvents = False
        If Target.Offset(0, -17) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -17).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -16) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -16).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -15) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -15).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 20 Then
    Application.EnableEvents = False
        If Target.Offset(0, -18) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -18).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -17) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -17).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -16) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -16).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 21 Then
    Application.EnableEvents = False
        If Target.Offset(0, -19) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -19).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -18) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -18).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -17) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -17).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 22 Then
    Application.EnableEvents = False
        If Target.Offset(0, -20) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -20).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -19) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -19).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -18) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -18).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 23 Then
    Application.EnableEvents = False
        If Target.Offset(0, -21) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -21).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -20) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -20).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -19) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -19).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 24 Then
    Application.EnableEvents = False
        If Target.Offset(0, -22) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -22).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -21) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -21).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -20) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -20).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 25 Then
    Application.EnableEvents = False
        If Target.Offset(0, -23) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -23).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -22) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -22).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -21) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -21).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 26 Then
    Application.EnableEvents = False
        If Target.Offset(0, -24) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -24).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -23) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -23).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -22) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -22).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 27 Then
    Application.EnableEvents = False
        If Target.Offset(0, -25) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -25).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -24) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -24).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -23) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -23).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 28 Then
    Application.EnableEvents = False
        If Target.Offset(0, -26) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -26).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -25) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -25).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -24) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -24).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 29 Then
    Application.EnableEvents = False
        If Target.Offset(0, -27) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -27).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -26) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -26).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -25) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -25).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 30 Then
    Application.EnableEvents = False
        If Target.Offset(0, -28) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -28).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -27) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -27).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -26) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -26).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 31 Then
    Application.EnableEvents = False
        If Target.Offset(0, -29) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -29).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -28) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -28).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -27) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -27).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 32 Then
    Application.EnableEvents = False
        If Target.Offset(0, -30) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -30).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -29) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -29).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -28) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -28).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 33 Then
    Application.EnableEvents = False
        If Target.Offset(0, -31) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -31).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -30) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -30).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -29) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -29).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 34 Then
    Application.EnableEvents = False
        If Target.Offset(0, -32) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -32).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -31) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -31).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -30) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -30).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 35 Then
    Application.EnableEvents = False
        If Target.Offset(0, -33) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -33).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -32) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -32).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -31) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -31).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 36 Then
    Application.EnableEvents = False
        If Target.Offset(0, -34) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -34).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -33) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -33).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -32) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -32).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
    If Target.Column = 37 Then
    Application.EnableEvents = False
        If Target.Offset(0, -35) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -35).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -34) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -34).Address & " en premier"
            Target = ""
        ElseIf Target.Offset(0, -33) = "" Then
            MsgBox "Vous devez remplir la cellule " & Target.Offset(0, -33).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
End Sub

Merci d'avance à tous pour votre aide.
 
Trier par date Trier par votes
Modeste

Modeste

XLDnaute Barbatruc
Re : validation de données via VBA + combobox en cascade

Bonjour Cedric_C et bienvenue,

Avant d'aller plus loin, nous n'avons nul besoin de ton fichier réel: il nous suffirait de disposer d'un exemple avec quelques données "bidon", mais qui représenterait l'architecture de ton classeur de travail. Celui-ci nous permettrait:
  1. d'identifier de quel type de contrôle tu parles, lorsque tu évoques des Combo Box
  2. de pouvoir tester toute proposition, avant de la soumettre ici

Tes listes, ce sont des validations, des contrôles de formulaires, des ActiveX, etc... ?

Quand tu dis "si les combo box sont vides, il autorise l'encodage dans la case où il se trouve" ... qui est le dernier 'il' ? L'utilisateur du fichier, le comboBox, ... :confused:

Ce que nous aurions pu vérifier, par exemple, c'est s'il n'était pas possible de remplacer tes 400 lignes de code, par
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column >= 8 And Target.Column < 38 Then
    Application.EnableEvents = False
        If Cells(Target.Row, 2) = "" Then
            MsgBox "Vous devez remplir la cellule " & Cells(Target.Row, 2).Address & " en premier"
            Target = ""
        ElseIf Cells(Target.Row, 3) = "" Then
            MsgBox "Vous devez remplir la cellule " & Cells(Target.Row, 3).Address & " en premier"
            Target = ""
        ElseIf Cells(Target.Row, 4) = "" Then
            MsgBox "Vous devez remplir la cellule " & Cells(Target.Row, 4).Address & " en premier"
            Target = ""
        End If
    Application.EnableEvents = True
    End If
End Sub
 
Vote positif 0 Vote négatif
C

Cedric_C

XLDnaute Nouveau
Re : validation de données via VBA + combobox en cascade

Salut Modeste,

Tu trouveras un exemple en attaché.

Pour info, j'ai testé ton code mais il ne fonctionne pas tout à fait comme il faudrait.
En fait, le code que tu me donnes ne se reste apparemment pas à chaque ligne. Du coup, si la première ligne est bonne, il ne contrôle plus les suivantes.

J'ai donc remis le mien pour que tu puisses voir comment le fichier entier fonctionne à l'heure actuelle.

Les listes ne sont pas des validations de données. Mon collègue a mis au point un code vba pour créer les combobox (code que tu trouveras dans le fichier aussi).

Mon code est le tout dernier.

Alors, quand je disais : "si les combo box sont vides, il autorise l'encodage dans la case où il se trouve" : le "IL se trouve" est l'utilisateur. Exemple : si je suis en H18 et que j'écris un chiffre, si B18 = "" ou si C18 = "" ou si D18 = "" alors il me met le message d'erreur et vide la case H18.
et j'aimerais donc ajouter à mon code : "SAUF si le contenu des combobox 1, 2 et 3 est vide"
et quand je passe à H19 le code doit recommencer le test.

Je ne sais pas si j'ai été plus clair comme ça mais n'hésite pas à revenir vers moi après avoir jeter un oeil si tu as des questions.

Merci pour ton aide.

Bien à toi,

Cédric.
 

Pièces jointes

  • Pointages - Test Restriction encodage.xlsm
    107.7 KB · Affichages: 55
  • Pointages - Test Restriction encodage.xlsm
    107.7 KB · Affichages: 71
  • Pointages - Test Restriction encodage.xlsm
    107.7 KB · Affichages: 71
Vote positif 0 Vote négatif
Modeste

Modeste

XLDnaute Barbatruc
Re : validation de données via VBA + combobox en cascade

Re-bonjour,

Quelque chose doit m'échapper: le code que j'ai proposé (comme le tien) se déclenche lors de la saisie des prestations en colonnes H à AK. La vérification est faite pour les colonnes B, C et D de la ligne où la modification a lieu :confused:
Je ne comprends donc pas le sens de
En fait, le code que tu me donnes ne se reste apparemment pas à chaque ligne. Du coup, si la première ligne est bonne, il ne contrôle plus les suivantes.
Cliquez pour agrandir...


D'autre part, si j'ai bien compris, il n'y aurait que la colonne D qui pourrait ne rien afficher. La difficulté étant ici de savoir s'il s'agit d'un oubli ... ou non!?
Vois avec ton collègue (qui se charge de cette partie-là) mais pourquoi, lorsqu'il n'y a pas de liste à afficher en colonne D, ne pas faire figurer un "code" qui permettra de savoir que la liste était vide (comme afficher un tiret, une mention "sans objet" ou "NC" ... ou tout ce que vous voulez!)
 
Vote positif 0 Vote négatif
C

Cedric_C

XLDnaute Nouveau
Re : validation de données via VBA + combobox en cascade

Salut Modeste,

Mea Culpa ! Ton code fonctionne très bien.
J'ai dû faire une fausse manip la première fois...

Ce serait effectivement impeccable si ce nouveau code écrivait automatiquement par exemple "Neant" dans la cellule concernée si la Combobox3 devient vide en fonction des choix dans les combobox1 et 2.

Le problème, c'est qu'on ne sait pas comment s'y prendre...

Je pensais à nouveau à If ComboBox1.ListCount = 0 Then mais je ne parviens pas à trouver où l'inclure ni quoi écrire après...

Est-ce que le nom du code change qqch?
Je veux dire, si on écrit : Private Sub Combobox_change plutôt que worksheet_change, cela fonctionnerait mieux?

Pourrais-tu nous aider pour cela aussi, stp?

Merci d'avance,
 
Vote positif 0 Vote négatif
Modeste

Modeste

XLDnaute Barbatruc
Re : validation de données via VBA + combobox en cascade

Bonsoir Cédric_C (et son collègue),

C'est toujours plus compliqué d'intervenir quand le code a été écrit par quelqu'un d'autre ... d'autant que je ne m'y serais pas pris de la même manière.

De ce que j'ai compris, une combobox est utilisée pour chaque colonne (B, C et D) et "positionnée" à hauteur de la cellule modifiée. Cette combobox n'a donc qu'une existence virtuelle et éphémère.
Elle est "garnie" dans la procédure Worksheet_SelectionChange, dans la partie commençant par
If Not Intersect([d12:d3851], Target) Is Nothing .... Il y a là une boucle For qui incrémente une variable ligne. À la sortie de la boucle, on peut tester si le premier élément de TblPositions contient un élément et donc si la liste sera garnie ... ou restera vide (si j'ai bien compris!?)
Tu peux donc faire un test à la sortie de cette boucle; si ligne > 1 tu exécutes les instructions qui sont prévues. Sinon, tu inscris "néant" dans "Target". La portion de code concernée deviendrait donc:
VB: 
If Not Intersect([d12:d3851], Target) Is Nothing And Target.Count = 1 Then
    Condition1 = UCase(Target.Offset(, -2))
    Condition2 = UCase(Target.Offset(, -1))
    If Condition1 = "" Or Condition2 = "" Then Exit Sub
    Chantiers = Application.Transpose(Sheets("BD").Range("Chantiers").Value)
    Fonctions = Application.Transpose(Sheets("BD").Range("Fonctions").Value)
    Positions = Application.Transpose(Sheets("BD").Range("Positions").Value)
    ligne = 0
    ReDim TblPositions(1 To UBound(Fonctions))
    For i = LBound(Chantiers) To UBound(Chantiers)
      If Fonctions(i) = Condition1 And Chantiers(i) = Condition2 Then
         ligne = ligne + 1: TblPositions(ligne) = Positions(i)
      End If
    Next i
    If TblPositions(1) <> "" Then
        ReDim Preserve TblPositions(1 To ligne)
        Me.ComboBox3.List = TblPositions
        Me.ComboBox3.Height = Target.Height + 3
        Me.ComboBox3.Width = Target.Width
        Me.ComboBox3.Top = Target.Top
        Me.ComboBox3.Left = Target.Left
        Me.ComboBox3 = Target
        Me.ComboBox3.Visible = True
        Me.ComboBox3.Activate
    'If Target <> "" Then SendKeys "{esc}"
    'Me.ComboBox1.DropDown    ' ouverture automatique au clic dans la cellule (optionel)
    Else
        Target = "Néant"
    End If
 Else
    Me.ComboBox3.Visible = False
 End If

J'insiste sur la nécessité de faire des tests plus approfondis (je me suis contenté d'en faire 2!). Comme la procédure me semble "lourde", je ne me suis pas appesanti :eek:
 
Vote positif 0 Vote négatif
BOISGONTIER

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : validation de données via VBA + combobox en cascade

Bonsoir,

Autre solution sans saisie intuitive

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect([b12:b52], Target) Is Nothing And Target.Count = 1 Then
      Set d1 = CreateObject("Scripting.Dictionary")
      For Each c In [choix1]:  d1(c.Value) = "": Next c
      For Each c In d1.keys: temp = temp & c & ",": Next c
      Target.Validation.Delete
      Target.Validation.Add xlValidateList, Formula1:=Left(temp, Len(temp) - 1)
     End If
     If Not Intersect([c12:c52], Target) Is Nothing And Target.Count = 1 Then
      Set d1 = CreateObject("Scripting.Dictionary")
      For Each c In [choix2]
        If c.Offset(0, -1) = Target.Offset(0, -1) Then d1(c.Value) = ""
      Next c
      If d1.Count > 0 Then
         For Each c In d1.keys: temp = temp & c & ",": Next c
           Target.Validation.Delete
           If temp = "," Then Target = "Néant": Target.Offset(, 1) = "Néant": Exit Sub
           Target.Validation.Add xlValidateList, Formula1:=Left(temp, Len(temp) - 1)
       End If
     End If
     If Not Intersect([d12:d52], Target) Is Nothing And Target.Count = 1 Then
       Set d1 = CreateObject("Scripting.Dictionary")
       For Each c In [choix3]
         If c.Offset(0, -1) = Target.Offset(0, -1) And _
            c.Offset(0, -2) = Target.Offset(0, -2) Then d1(c.Value) = ""
       Next c
       If d1.Count > 0 Then
         For Each c In d1.keys: temp = temp & c & ",": Next c
           Target.Validation.Delete
           If temp = "," Then Target = "Néant": Exit Sub
           Target.Validation.Add xlValidateList, Formula1:=Left(temp, Len(temp) - 1)
        End If
    End If
 End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect([b12:b52], Target) Is Nothing And Target.Count = 1 Then
       Target.Offset(, 1) = "": Target.Offset(, 2) = ""
       n = 0
       For Each c In [choix2]
          If c.Offset(0, -1) = Target.Value And c <> "" Then n = n + 1
       Next c
       If n = 0 Then Target.Offset(, 1) = "Néant": Target.Offset(, 2) = "Néant"
       Target.Validation.Delete
     End If
     If Not Intersect([c12:c52], Target) Is Nothing And Target.Count = 1 Then
       Target.Offset(, 1) = ""
       n = 0
       For Each c In [choix3]
          If c.Offset(0, -1) = Target.Value And c <> "" Then n = n + 1
       Next c
       If n = 0 Then Target.Offset(, 1) = "Néant"
       Target.Validation.Delete
     End If
End Sub

JB
 

Pièces jointes

  • DVDynmique3Niveaux.xlsm
    28.8 KB · Affichages: 56
  • Pointages - Test Restriction encodage.xlsm
    97.1 KB · Affichages: 48
  • Pointages - Test Restriction encodage.xlsm
    97.1 KB · Affichages: 71
  • Pointages - Test Restriction encodage.xlsm
    97.1 KB · Affichages: 65
Dernière édition:
Vote positif 0 Vote négatif
Modeste

Modeste

XLDnaute Barbatruc
Re : validation de données via VBA + combobox en cascade [résolu]

Bonjour,
Salut JB,

Cedric_C à dit:
Salut Modeste,
Merci cela fonctionne bien !
Bonne journée.
Cliquez pour agrandir...

Comme disait l'autre: "J'en suis fort aise!" ... mais quoi, pas un mot sur la proposition de Jacques BOISGONTIER :eek: Tu ne l'as pas vue? Si tu l'avais testée, tu aurais sans doute compris ce que je trouvais de "lourd" dans la solution que vous avez mise en oeuvre (et qui se trouve plus que sensiblement allégée, dans cette autre version).
On peut comprendre que ça t'effraie de modifier à ce stade, mais un petit mot de reconnaissance, tout de même, pour le temps consacré ...

Au moins, les prochains qui passeront par ici auront deux approches à comparer ... merci pour eux, donc, JB :)
 
Vote positif 0 Vote négatif

Discussions similaires

Jouxte
  • Question
XL 2021 coller une image interne au classeur
2 3
Réponses
33
Affichages
1 K
Jouxte
Jouxte
T
  • Résolu(e)
XL 2019 Contrôle de saisie d'heures
Réponses
10
Affichages
324
ThierryP
T
AlCapone
  • Résolu(e)
Microsoft 365 VBA - BeforeDoubleClick, 1ère cellule vide à partir de cellule active pour insertion de ligne
Réponses
4
Affichages
112
AlCapone
AlCapone
F
  • Question
XL 2016 Vba + formule actualisation
Réponses
8
Affichages
324
Dudu2
Dudu2
B
  • Résolu(e)
Microsoft 365 Besoin d'aide pour faire fonctionner 2 codes VBA ensemble
Réponses
2
Affichages
272
BenExcel
B
ralph45
  • Question
Microsoft 365 [VBA] Listes déroulantes à choix multiples sur N colonnes discontinues
Réponses
4
Affichages
518
ralph45
ralph45
D
  • Question
XL 2010 Identification d'une cellule cliquée
Réponses
6
Affichages
568
dadu35
D
S
  • Résolu(e)
Microsoft 365 Listes déroulantes multi-sélections et feuilles protégées.
Réponses
6
Affichages
422
selkis
S
D
  • Question
XL 2010 Valoriser cellule par clic
Réponses
4
Affichages
423
fanch55
fanch55
S
  • Résolu(e)
Microsoft 365 Inscrire automatiquement la date du jour et bloquer les cellules
Réponses
4
Affichages
575
sebastien176
S

Membres actuellement en ligne

2 membres et 44 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 645
Messages
2 111 536
Membres
111 184
dernier inscrit
amiko