XL 2010 Trier un dictionnaire par ordre alphabétique

[Magic_Doctor]

Bonsoir,

Sur une feuille il y a plusieurs ComboBox. Seuls certains recueillent une liste d’items se trouvant dans la même base de données située sur une autre feuille. Quand on ouvre le classeur, tous les ComboBox concernés par ladite liste sont chargés. Quand on choisit un item dans l’un de ces ComboBox, il disparaît dans la liste des autres ComboBox, de telle sorte qu’il est impossible de choisir par inadvertance plusieurs fois le même item. Jusqu’à présent tout marche bien. Mon seul souci, c’est que je voudrais que les ComboBox présentent une liste triée par ordre alphabétique. En effet, dans la BD cette liste n’est pas forcément ordonnée par ordre alphabétique (comme dans la PJ). J’ai trouvé une fonction (ici) qui, théoriquement, devrait permettre de résoudre ce problème, mais je n’ai pas su l’adapter à l’application.

 

[M12]

Bonjour,
A tester

 

[Magic_Doctor]

Bonjour,

Merci pour votre intervention. Ça marche, mais dommage que dans la liste de chaque ComboBox la dernière ligne est inutilement vide.
Il suffisait donc de remplacer :

liste = SortDictionaryByKey (liste)

par :

SortDictionaryByKey (liste(c))

Franchement, je n'y aurais pas pensé.
Par curiosité, j'ai fait la substitution dans le fichier natif et, contre toute attente, ça ne marche pas avec en plus la dernière ligne de chaque liste vide. Il est tard chez moi, peut-être la fatigue... mais aurais-je raté quelque chose ?

Encore merci et bonne journée septentrionale.

 

[job75]

Bonjour Magic_Doctor, M12, le forum,

Le plus simple est de trier la plage source :

    With f2.Range("ListeItems").Offset(, 2)
        .Value = .Offset(, -2).Value
        .Sort .Cells, xlAscending, Header:=xlNo 'tri
        For Each c In .Cells
            If Len(c) Then liste(c.Value) = "" 'on remplit le dictionnaire
        Next
        .ClearContents
    End With

Notez aussi que On Error Resume Next est inutile car on teste plus loin liste.Exists(c.Object.Value)

A+

 

[Magic_Doctor]

Bonjour job, le forum,

Bravo ! En effet, pourquoi faire compliqué quand on peut faire simple. Pour un truc, ma foi, assez sophistiqué, la solution finit par être, disons, minimaliste. Cela dit en passant, cette application est très pratique quand on a plusieurs ComboBox avec les mêmes items.
Quoi qu'il en soit, tout comme les Arrays, trier les dicos c'est plutôt tartignole... Curieux que Microsoft n'ait pas conçu des fonctions pour le faire.

A +

 

[Magic_Doctor]

Une dernière pour la route.
Petite simplification : il suffit de mettre le préfixe des ComboBox de son choix dans "Workbook_Open()".

 

[patricktoulon]

Bonjour

Curieux que Microsoft n'ait pas conçu des fonctions pour le faire.

ben en fait Si !! il l'a fait ( et depuis longtemps) sauf que c'est pas l'object "scripting.dictionary"
mais le
system.collection.arraylist qui possède sa propre fonction".sort"
qui est plus un tableau car il n'a pas de key/item
et le
system.collection.sortedlist 'qui est trié automatiquement dans l'ordre chron ou apha
qui est tres similaire au dictionnaire
et plus recemment
system.collection.generic.sortedlist 'idem que son prédécesseur (je ne l'ai pas encore étudié en VBA)
qui est le même mais plus récent

pour le sortedlist
late binding

Set SortL= CreateObject("System.Collections.SortedList")

early binding

dim SortL as new SortedList

une source parmi tant d'autres ci dessous

CreateObject(« System.Collections.SortedList ») – Grand Chaman Excel

pour le arraylist
late binding

Set ARRL = CreateObject("System.Collections.ArrayList")

early binding

Dim ARRL As New ArrayList

une source parmi tant d'autres ci dessous

CreateObject(« System.Collections.ArrayList ») – Grand Chaman Excel

si tes mises a jour Windows sont a jour
donc tu a certainement une des version de net framework ci dessous ,donc tu l'a dans tes librairies

.NET Framework	1.1, 2.0, 3.0, 3.5, 4.0, 4.5, 4.5.1, 4.5.2, 4.6, 4.6.1, 4.6.2, 4.7, 4.7.1, 4.7.2, 4.8

have a good day

 

[Magic_Doctor]

Bonjour patricktoulon,

Merci pour ces infos. Puissants ces objets ! Mais il est vrai qu'ils sont un peu confidentiels.
Va falloir que j'abandonne Excell 2007 et que je me modernise.

 

[patricktoulon]

Bonsoir @Magic_Doctor
ils sont plus vieux que le dictionnaire je crois
tu les a avec 2007 si tu a au moins net framework version 3.5

 

[Magic_Doctor]

Re,

Ce soir je vais faire un essai pour voir.
Quoi qu'il en soit, il faut que j'évolue.

 

[patricktoulon]

re
tu a des lien pour les deux et des exemple de code dedans teste les et si ca marche
ben tu les a sinon c'est que ta version net framework n'est pas a jour meme pour W7 et office 2007

 

[Magic_Doctor]

Re,

Je viens d'essayer en m'appuyant sur l'exemple du @Grand Chaman Excel et ça marche !
L'euphorie aidant, j'ai tenté de remplacer :

Sub CreeListeDispo(nomCombo$)

Dim f1 As Worksheet, f2 As Worksheet, c, liste As Scripting.Dictionary

    Set f1 = Sheets("Données")
    Set f2 = Sheets("BD")
    Set liste = New Dictionary                   'le dictionnaire
    
    With f2.Range("ListeItems").Offset(, 2)      'on tri, par ordre alphabétique, dans une colonne "fantôme" dédiée sur la feuille "BD"
        .Value = .Offset(, -2).Value             'récupération dans la colonne "fantôme" de l'intégralité de "ListeItems"
        .Sort .Cells, xlAscending, Header:=xlNo  'tri
        For Each c In .Cells
            If Len(c) Then liste(c.Value) = ""   'on remplit le dictionnaire
        Next
        .ClearContents                           'la colonne "fantôme" est purgée
    End With
            
    For Each c In f1.OLEObjects
        If TypeName(c.Object) = "ComboBox" And Left(c.Name, 10) = nomCombo Then  'on passe en revue tous les ComboBox présents dans la feuille et on ne retient que ceux dont le nom commence par "ComboListe"
            If liste.Exists(c.Object.Value) Then liste.Remove c.Object.Value
        End If
    Next
    
    For Each c In f1.OLEObjects
        If TypeName(c.Object) = "ComboBox" And Left(c.Name, 10) = nomCombo Then  'on passe en revue tous les ComboBox présents dans la feuille et on ne retient que ceux dont le nom commence par "ComboListe"
            c.Object.List = liste.Keys
        End If
    Next
End Sub

par :

Sub CreeListeDispo(nomCombo$)

Dim f1 As Worksheet, f2 As Worksheet, c
Dim cel As Range, AL As Object

    Set f1 = Sheets("Données")
    Set f2 = Sheets("BD")
    Set AL = CreateObject("System.Collections.ArrayList")
    
    For Each cel In f2.Range("ListeItems")       'on dresse l'Array
       AL.Add cel.Text                           'il faut utiliser ".Text" sinon impossible de trier, car on enverrait un "range"
    Next
    AL.Sort                                      'tri, par ordre alphabétique, de l'Array
    
    For Each c In f1.OLEObjects
        If TypeName(c.Object) = "ComboBox" And Left(c.Name, 10) = nomCombo Then  'on passe en revue tous les ComboBox présents dans la feuille et on ne retient que ceux dont le nom commence par "ComboListe"
'            If liste.Exists(c.Object.Value) Then liste.Remove c.Object.Value
             AL.Remove c.Object.Value
        End If
    Next
    
    For Each c In f1.OLEObjects
        If TypeName(c.Object) = "ComboBox" And Left(c.Name, 10) = nomCombo Then  'on passe en revue tous les ComboBox présents dans la feuille et on ne retient que ceux dont le nom commence par "ComboListe"
'            c.Object.List = liste.Keys
            c.Object.List = AL  'ça plante là
        End If
    Next
End Sub

Mais ça beugue...

 

[Magic_Doctor]

Bonsoir,

J'ai finalement réussi à résoudre le problème en tombant sur un blog du Grand Chaman Excel (ici) :

Sub CreeListeDispo(nomCombo$)

Dim f1 As Worksheet, f2 As Worksheet, c, AL As Object

    Set f1 = Sheets("Données")
    Set f2 = Sheets("BD")
    Set AL = CreateObject("System.Collections.ArrayList")
    
    For Each c In f2.Range("ListeItems")  'on dresse l'Array "AL"
       AL.Add c.Text                      'il faut utiliser ".Text" sinon impossible de trier, car on enverrait un "Range"
    Next
    AL.Sort                               'tri, par ordre alphabétique, de l'Array
    
    For Each c In f1.OLEObjects
        If TypeName(c.Object) = "ComboBox" And Left(c.Name, 10) = nomCombo Then  'on passe en revue tous les ComboBox présents dans la feuille et on ne retient que ceux dont le nom commence par "ComboListe"
             AL.Remove c.Object.Value
        End If
    Next
    
    For Each c In f1.OLEObjects
        If TypeName(c.Object) = "ComboBox" And Left(c.Name, 10) = nomCombo Then  'on passe en revue tous les ComboBox présents dans la feuille et on ne retient que ceux dont le nom commence par "ComboListe"
            c.Object.List = AL.ToArray
        End If
    Next
End Sub

Un peu plus concis et le tri se fait hors de la feuille.

 

[patricktoulon]

re
bonjour
voilà t a tout compris
conclusion Ms l'avait fait

bien que l'idée ( de @job75) de tri sur feuile avant reste la meilleure solution et la plus économique
j’étais intervenu uniquement pourdire qu' il existait donc bien un outils a cet effet utilisable en VBA
garde bien au chaud les deux liens

 

[ChTi160]

Bonjour Magic_Doctor
Bonjour le Fil ,le Forum

il n'y aurait pas moyen de fusionner ces deux Boucles ?

For Each c In f1.OLEObjects
        If TypeName(c.Object) = "ComboBox" And Left(c.Name, 10) = nomCombo Then  'on passe en revue tous les ComboBox présents dans la feuille et on ne retient que ceux dont le nom commence par "ComboListe"
             AL.Remove c.Object.Value
        End If
Next
    
For Each c In f1.OLEObjects
        If TypeName(c.Object) = "ComboBox" And Left(c.Name, 10) = nomCombo Then  'on passe en revue tous les ComboBox présents dans la feuille et on ne retient que ceux dont le nom commence par "ComboListe"
            c.Object.List = AL.ToArray
        End If
Next
'En
For Each c In f1.OLEObjects
        If TypeName(c.Object) = "ComboBox" And Left(c.Name, 10) = nomCombo Then  'on passe en revue tous les ComboBox présents dans la feuille et on ne retient que ceux dont le nom commence par "ComboListe"
             AL.Remove c.Object.Value
                       c.Object.List = AL.ToArray
        End If
Next

Bonne journée
Jean marie