[XL-2007] Problème Liste déroulante

[alexandre46]

Bonjour,

J'ai réalisé un fichier excel pour gérer la gestion du stock de ma clinique lors de la periode de transition entre les 2 GMAO. Le fichier est déjà bien avancé, il ne reste que quelques "finitions" a faire.

J'ai, donc, créé une feuille avec la BD qui contient :

• le code
• le founisseur
• la désignation
• la référence
• le nombre de pièce en stock
• le Prix HT
• la TVA
• le prix TTC

J'ai aussi créé une feuille pour la saisie de nouvelles lignes (tout est automatisé avec des macros)

Et j'ai aussi créé une feuille pour la consultation, modification et suppression des lignes de l'inventaire. J'ai inséré 3 listes déroulantes, une affiche le founisseur, l'autre la désignation et la dernières la référence (il y a un lien entre les 3 listes déroulantes bien évidement). Le reste des informations est affichées dans un tableau avec une colonne pour la modification et une macro est là pour enregistré les modifications. Mon problème est que je voudrais que la 1ère liste déroulante avec les fournisseur n'affiche pas les fournisseur plusieurs fois et que quand je sélectionne un fournisseur, il n'y est que ses pièces affichées dans les 2 autres listes déroulantes.

J'ai pensé a ça pour facilité la recherche..

[Imaginer c'est bien. Le réaliser, c'est mieux]

Merci d'avance,

[Daniel.C]

Bonjour,

Pour une liste déroulante en H4 les fournisseurs étant en colonne B (tout est sur Feuil2, à adapter.) :

Code :

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
Sub test()
    Dim Dico As Object, item As String, c As Range
    Set Dico = CreateObject("Scripting.Dictionary")
    'plage fournisseurs
    With Sheets("Feuil2")
        For Each c In .Range(.[B2], .Cells(.Rows.Count, 2).End(xlUp))
            If Not Dico.exists(c.Value) Then
                Dico.Add c.Value, c.Value
            End If
        Next c
        .[M1].Resize(Dico.Count) = Application.Transpose(Dico.items)
        With .[H4].Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=" & Sheets("Feuil2").Range("M1").Resize(Dico.Count).Address
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    End With
 
End Sub

Pour la liste déroulante des pièces (se trouvant en colonnes C), mets dans le module de la feuille :

Code :

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
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$H$4" Then Exit Sub
    Dim Dico As Object, item As String, c As Range
    Set Dico = CreateObject("Scripting.Dictionary")
    For Each c In Range([C2], Cells(Rows.Count, 3).End(xlUp))
        If Not Dico.exists(c.Value) And c.Offset(, -1) = [H4] Then
            Dico.Add c.Value, c.Value
        End If
    Next c
    Application.EnableEvents = False
    [N1].Resize(Dico.Count) = Application.Transpose(Dico.items)
    With [J4].Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=" & Sheets("Feuil2").Range("N1").Resize(Dico.Count).Address
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Application.EnableEvents = True
End Sub

[alexandre46]

D'abord, merci d'avoir répondu si rapidement.

J'aurai besoin de quelques informations supplémentaires..

Que dois je mettre a la place de "Scripting.Dictionary" et la place de "Formula1:="=" " et de :

Code :

1
2
3
4
        .InputTitle = ""
         .ErrorTitle = ""
         .InputMessage = ""
         .ErrorMessage = ""

[Daniel.C]

Que dois je mettre a la place de "Scripting.Dictionary" et la place de "Formula1:="=" "

??? Qu'est-ce que tu veux faire ?

et de :
" .InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = "" "

Je ne peux pas le savoir pour toi. clique dans le mot "validation" et appuie sur F1. Tu vas trouver des explications pour ces propriétés.

[alexandre46]

Comme tes caractères en rouge sont ceux que je dois adapter a ma page, je n'arrive pas a trouver de similitude entre ça et mon fichier.

En faite, je ne voudrais pas mettre la liste déroulante dans une cellule mais dans une liste de zone déroulante (Contrôle de formulaire) qui me laisse une plus grande liberté de personnalisation.

[Daniel.C]

Comme tes caractères en rouge sont ceux que je dois adapter a ma page, je n'arrive pas a trouver de similitude entre ça et mon fichier.

Le code est toujours en noir et blanc. C'est l'éditeur de code du forum qui se charge de la coloration pour plus de clarté. Si cela te gêne, n'en tiens pas compte.

Avec "Zone Combinée 2" pour les fournisseurs, alimentée par M1:Mx et la cellule liée en G1. Avec "Zone Combinée 3" pour les pièces alimentée par N1:Nx. Les données fournisseurs sont en B2:Bx et les pièces en C2:Cx. Dans une cellule inoccupée : =G1*2. Le tout sur Feuile2.

Dans un module pour la mise à jour de la liste fournisseurs :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 Sub test()
    Dim Dico As Object, item As String, c As Range
    Set Dico = CreateObject("Scripting.Dictionary")
    'plage fournisseurs
    With Sheets("Feuil2")
        For Each c In .Range(.[B2], .Cells(.Rows.Count, 2).End(xlUp))
            If Not Dico.exists(c.Value) Then
                Dico.Add c.Value, c.Value
            End If
        Next c
        .[M1].Resize(Dico.Count) = Application.Transpose(Dico.items)
    End With
    ActiveSheet.Shapes.Range("Drop Down 2").Select
    With Selection
        .ListFillRange = Sheets("Feuil2").Range("M1").Resize(Dico.Count).Address
        .LinkedCell = "$G$1"
        .DropDownLines = 8
    End With
End Sub

Dans le module de feuil2 :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Worksheet_Calculate()
    Dim Dico As Object, item As String, c As Range
    Set Dico = CreateObject("Scripting.Dictionary")
    For Each c In Range([C2], Cells(Rows.Count, 3).End(xlUp))
        If Not Dico.exists(c.Value) And c.Offset(, -1) = _
            Application.Index([M:M], [G1]) Then
            Dico.Add c.Value, c.Value
        End If
    Next c
    Application.EnableEvents = False
    [N1].Resize(Dico.Count) = Application.Transpose(Dico.items)
    ActiveSheet.Shapes.Range("Drop Down 3").Select
    With Selection
        .ListFillRange = Sheets("Feuil2").Range("N1").Resize(Dico.Count).Address
        .LinkedCell = "$H$1"
        .DropDownLines = 8
    End With
    Application.EnableEvents = True
End Sub

[alexandre46]

Je n'arrive pas a le mettre en pratique dans mon classeur.. Il y a toujours un bog qui survient... Serait il possible que je te passe une copie de mon fichier ? ça sera peut être plus simple en finalité...

[Daniel.C]

Oui, bien sûr. Comme je crois que l'espace qui t'es alloué est restreint, ne conserve que le nécessaire et si tu le peux, compacte-le avec winzip ou winrar.

[alexandre46]

Tout d'abord, merci beaucoup.

J'ai retiré une grosse partie des lignes du stock et quelques pages.. Le problème est dans la feuille "Consultation".

Encore merci

[Daniel.C]

Effectivement, j'ai dû faire pas mal de modifs, car mon classeur de test avait tout sur la même feuille. Pour résumer, Dans le module "thisworkbook" :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub Workbook_Open()
    Dim Dico As Object, item As String, c As Range
    Set Dico = CreateObject("Scripting.Dictionary")
    'plage fournisseurs
    With Sheets("BD")
        For Each c In .Range(.[B2], .Cells(.Rows.Count, 2).End(xlUp))
            If Not Dico.exists(c.Value) Then
                Dico.Add c.Value, c.Value
            End If
        Next c
        Sheets("Consultation").Select
        [U1].Resize(Dico.Count) = Application.Transpose(Dico.items)
    End With
    Sheets("Consultation").Shapes.Range("Drop Down 8").Select
    With Selection
        .ListFillRange = Range("U1").Resize(Dico.Count).Address
        .LinkedCell = "$G$1"
        .DropDownLines = 8
    End With
End Sub

Dans le module de la feuille "Consultation" :

Code :

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
Private Sub Worksheet_Activate()
    Dim Dico As Object, item As String, c As Range
    Set Dico = CreateObject("Scripting.Dictionary")
    'plage fournisseurs
    With Sheets("BD")
        For Each c In .Range(.[B2], .Cells(.Rows.Count, 2).End(xlUp))
            If Not Dico.exists(c.Value) Then
                Dico.Add c.Value, c.Value
            End If
        Next c
        Sheets("Consultation").[U1].Resize(Dico.Count) = Application.Transpose(Dico.items)
    End With
    Sheets("Consultation").Select
    Shapes.Range("Drop Down 8").Select
    With Selection
        .ListFillRange = Range("U1").Resize(Dico.Count).Address
        .LinkedCell = "$G$1"
        .DropDownLines = 8
    End With
End Sub
Private Sub Worksheet_Calculate()
    Dim Dico As Object, item As String, c As Range
    Set Dico = CreateObject("Scripting.Dictionary")
    Sheets("Consultation").Select
    With Sheets("BD")
        If [Consultation!G1] = "" Then Exit Sub
        For Each c In .Range(.[C2], .Cells(.Rows.Count, 3).End(xlUp))
            If Not Dico.exists(c.Value) And c.Offset(, -1) = _
                Application.Index([U:U], [Consultation!G1]) Then
                Dico.Add c.Value, c.Value
            End If
        Next c
        Application.EnableEvents = False
        [Consultation!V1].Resize(Dico.Count) = Application.Transpose(Dico.items)
        Sheets("Consultation").Shapes.Range("Drop Down 1").Select
    End With
    With Selection
        .ListFillRange = Range("V1").Resize(Dico.Count).Address
        .LinkedCell = "$H$1"
        .DropDownLines = 8
    End With
    Application.EnableEvents = True
End Sub

Fais attention, pour le fournisseur Sider, il se trouve deux fois dans la liste, parce que il est orthographié parfois avec un espace à la fin. J'ai aussi supprimé la macro de la zone combinée "Fournisseurs". Je te joins le classeur modifié.
PS. Je n'ai pas compris l'utilité de la troisième zone combinée.

[alexandre46]

Merci,

C'est ce que je voulais au niveau des fournisseurs et des désignations. Mais j'aurai voulu garder le lien avec la zone combiné 3 (elle sert a rechercher des équipement si on a que la référence) et aussi avec le tableau pour effectuer mes modifications.. Je ne sais pas si c'est possible...

[Daniel.C]

J'ai fait des rectifs un peu partout, il faudrait trois tomes pour tout raconter. Regarde le fichier joint et si quelque chose ne fonctionne pas, dis-le.