Discussion :

[ouskel'n'or]

Où est l'erreur ?
Cette procédure, prise ds la FAQ, renseigne une liste sans doublons.
Pourquoi semble-t-elle fonctionner si la liste se trouve ds une feuille de calculs mais ne fonctionne pas si elle se trouve dans un userform...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub test1()
Dim Cell As Range
Feuil1.ComboBox1.Clear
For Each Cell In Worksheets("Feuil1").Range("A1:A" & Range("a" & Rows.Count).End(xlUp).Row)
    Worksheets("Feuil1").ComboBox1 = Cell
    If Worksheets("Feuil1").ComboBox1.ListIndex = -1 Then _
        Worksheets("Feuil1").ComboBox1.AddItem Cell
Next Cell

Propriété MatchEntry = fmMatchEntryComplete (par défaut)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub Test2()
Dim Cell As Range
    Me.ListBox1.clear 
    For Each Cell In Worksheets("Feuil1").Range("A1:A" & Range("a" & Rows.Count).End(xlUp).Row)
            ListBox1 = Cell 'Erreur 380
            If ListBox1.ListIndex = -1 Then ListBox1.AddItem Cell
    Next Cell
End Sub

Je pallie le pb en ajoutant une gestion d'erreur mais j'aime pas bien

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
        On Error Resume Next
            ListBox2 = Cell
            If ListBox2.ListIndex = -1 Then ListBox2.AddItem Cell

Une explication ?
Par avance, merci

[DarkVader]

Bonjour,
Le code suivant fonctionne pour un listbox ou un combo, contenu dans une feuille ou un userform.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub FillList(plage As Range, oList As Object)
    Dim lst()
 
    lst() = plage
 
    With oList
        .Clear
        .ColumnCount = UBound(lst, 2)
        .List = lst
    End With
End Sub

[ouskel'n'or]

Ok, Dark, bonjour et merci pour tes explications.
Ma question ne concerne pas le "remplissage" de la liste.
"LaListe.List = lst" fonctionne aussi bien dans une feuille de calculs que ds un usf. Pas de pb.
Le pb est l'affectation d'une valeur à la liste

ListBox1.value (ou Text) = Valeur
'ou pour simplifier
ListBox1 = Valeur

Dans le cas de la feuille de calculs, elle ne parait pas provoquer d'erreur
Dans un usf, cette même syntaxe provoque une erreur.
C'est sur ce point que je m'interrogeais : Ai-je oublié de modifier une propriété, un paramètre ?

[ucfoutu]

Bonjour ousk,

Je ne crois pas qu'il faille chercher une explication dans la méthode de remplissage de ta listbox, mais dans la manière dont tu récupères le contenu de ta cellule...(le contenu lui-même à tenter d'ajouter, quoi...)

La preuve ? oublions les cellules et remplaçons par les articles d'un array, ainsi :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Private Sub Command1_Click()
 toto = Array("bananes", "poires", "kiwis", "oranges", "bananes", "ananas", "kiwis")
 Listbox1.Clear
 For i = 0 To UBound(toto)
   Listbox1 = toto(i)
   If Listbox1.ListIndex = -1 Then Listbox1.AddItem toto(i)
 Next
End Sub

on voit bien que cela fonctionne (bananes et kiwis n'apparaissent qu'une fois et nous n'avons pas à gérer d'erreurs)

Il va donc te falloir chercher la raison de ton message d'erreur ailleurs que dans ta condition If (celle pour éviter les doublons).
Fais donc un premier test, avec les mêmes cellules, sans vouloir éviter les doublons, juste pour voir ce qui se passe (même message d'erreur ou pas ?)

[DarkVader]

Dans le cas de la feuille de calculs, elle ne parait pas provoquer d'erreur

Normal puisqu'il s'agit d'un combo

Dans un usf, cette même syntaxe provoque une erreur.
C'est sur ce point que je m'interrogeais : Ai-je oublié de modifier une propriété, un paramètre ?

alors que dans ce cas, il s'agit d'un listbox et non plus d'un combo,
et il me semble difficile d'attribuer une valeur à une liste vide. Non ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub Test2()
    Dim Cell As Range, lastValue As String
    Me.ListBox1.Clear
    For Each Cell In Worksheets("Feuil1").Range("A1:A" & Range("a" & Rows.Count).End(xlUp).Row)
        ListBox1.AddItem Cell
        lastValue = Cell.Value
    Next Cell
    ListBox1.Value = lastValue
End Sub

Me semble plus cohérent.

PS: Je préfère ma méthode de remplissage quand elle est utilisable

[ouskel'n'or]

Je reprends tout car j'ai dû rater quelque chose d'important dans mes explicatIons.

La méthode décrite (reprise de la FAQ) sert à renseigner une liste sans doublons.

Le constat que l'on peut faire est que si on saisit une donnée existante dans un combo, le combo affiche la donnée et on obtient une valeur ListIndex correspondant à l'indice de la donnée en question.

Si la donnée n'existe pas, LaListeOuLeCombo.listIndex = -1
Ceci étant une conséquence du paramètre fmMatchEntryComplete de la propriété MatchEntry.

Donc, je devrais obtenir la même chose avec une liste ou un combobox si je mets

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
LaListeOuLeCombo = UneDonnée
If LaListeOuLeCombo.ListIndex = -1 then LaListeOuLeCombo.addItem UneDonnée

Or, dans une feuille de calculs, cette syntaxe appliquée à un combo ne provoque pas d'erreur alors qu'elle en provoque une dans une liste placée dans un userform.

Ma question était donc : "Existe-t-il une explication et donc une solution autre que "Propriété MatchEntry = fmMatchEntryComplete" (qui est le paramètre par défaut de cette propriété) ?

La solution citée avec gestion d'erreur fonctionne mais que je préférerais m'en passer.

Enfin, quand je vous aurai dit que je cherche une alternative à la solution que j'utilise ici vous saurez vraiment tout de mon horrible cas de conscience .

Merci à tous de vous pencher sur mon triste sort.
Bon dimanche

[ucfoutu]

Bonjour, ousk,

Si je comprends bien, ce que tu cherches est une alternative, sans gestion d'erreur, à la méthode qui figure dans ton lien et qui consiste à boucler sur tous les articles de la listbox pour s'assurer de ce que l'ajout proposé n'existe pas déjà .

Cette alternative existe et consiste en l'utilisation de la fonction SendMessage de l'Api de Windows (de la librairie User32)

La difficulté est toutefois, sous VBA, que la dite fonction nécessite le hwnd de la listbox.

Il est possible d'extraire ce hwnd en utilisant la méthode suivante :
1) donner le focus à la listbox
2) utiliser la fonction GetFocus de la librairie User32 de l'Api de Windows (cette fonction retourne un long qui n'est précisément autre que le hwnd du contrôle ayant le focus).

Je suis ce matin occupé à assister (après la tempête) des personnes âgées ou "fragiles" dans mon voisinnage.
Si la méthode que je préconise t'intéresse mais que tu rencontres des difficultés à la mettre en oeuvre sur la seule base de ce que j'ai décrit plus haut, je m'y mettrai ensuite pour t'écrire le code complet.
Cette méthode présente l'énorme avantage, surtout si la liste comprend un grand nombre d'articles, d'être beaucoup plus rapide dans la détermination de l'existence d'un article de la listbox.
Tu dis...

[ouskel'n'or]

Merci ucfoutu, tu as bien compris ce que je souhaitais. Mais occupe-toi de tes voisins, je n'ai ni arbre sur le toit ni eau dans la cave.
Quand tu reviendras, si tu peux m'expliquer comment, pour chaque item ajouté, le parcours de la liste par ta méthode peut prendre moins de temps que celle utilisée, qui se contente de vérifier le dernier item existant, ou celle décrite en début de discussion, qui utilise la propriété MatchEntry.
Je te précise tout de même que seule une raison "esthétique" (tu sais de quoi je parle...) m'incite à chercher une autre solution... Et celle de SilkyRoad, donnée dans la FAQ, avait l'heur de correspondre "à mon goût personnel"

Une pensée amicale pour tes voisins.

[DarkVader]

1°)
J'avais omis le problème de la suppression de doublons parce que focalisé sur le problème de base

alors que dans ce cas, il s'agit d'un listbox et non plus d'un combo,
et il me semble difficile d'attribuer une valeur à une liste vide. Non ?

donc ma remarque reste la même :
un combo n'est un listbox
=> un combo accepte l'affectation de la propriété value même si elle n'existe pas dans la liste
=> le listbox n'accepte l'affectation de la propriété value que si elle existe dans le liste
en conséquence listbox1.value ne vaudra pas cell.value mais Null tant qu'aucune valeur aura été trouvée
puis la 1ère valeur cell.value trouvée et figera sur celle-ci -
le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ListBox1.Value = Cell.value

déclenchera donc obligatoirement une exception dès sa 1ère exécution.

2°)
Tu affirmes, le code fonctionne dans une feuille pas dans un userform :
Comme déjà indiqué plus haut (mais peut-être fallait-il lire entre les lignes)
tu utilisais un combo sur la feuille et un listbox dans l'userform
ce qui ne permettait pas de mettre en évidence que le problème est identique dans une feuille ou un userform.

[ouskel'n'or]

Ok pour ton explication : Les combo permettent des "choses" que les listes ne permettent pas. J'aurai au moins appris l'une de ces choses
Cependant je ne comprends toujours pas tout.
Je viens de constater que la gestion d'erreur ne règle pas le problème.
Elle ne fonctionne que si les données sans doublons se suivent dans la feuille et se répètent "en bloc"

Papa
maman
La bonne
Et moi
Papa
maman
La bonne
Et moi

mais ne fonctionne pas si les doublons se suivent

Papa
Papa
maman
La bonne
Et moi
Et moi
Et moi
Et moi ?

Ce qui me chagrine beaucoup car du coup je n'ai plus d'alternative (sauf à utiliser les algos connus pour supprimés les doublons, avec ou sans collection)

Merci pour votre compassion

[DarkVader]

.../...
en conséquence listbox1.value ne vaudra pas cell.value mais Null tant qu'aucune valeur aura été trouvée
puis la 1ère valeur cell.value trouvée et figera sur celle-ci -.../...

Tu lis tout ?

La solution, ucfoutu te l'as indiqué :
1°) récupérer le handle du control
2°) filtrer l'ajout avec un sendmessage LB_FINDSTRINGEXACT
(solution la plus rapide pour un grand nombre de données)

[ouskel'n'or]

Tu lis tout ?

Oui ! Avec la plus grande attention. Mais je ne comprends pas forcément tout, par exemple

puis la 1ère valeur cell.value trouvée et figera sur celle-ci

car avec une gestion d'erreur, dans ce cas de figure

Papa
maman
La bonne
Et moi
Papa
maman
La bonne
Et moi

ListBox1 = Cell provoque l'erreur et Listbox1.ListIndex donne -1 tant que la liste ne contient rien (et confirme le null que tu évoques) mais, dès la première donnée entrée et tant qu'elle ne rencontre pas de doublon, ListBox1 = Cell ne provoque pas d'erreur et Listbox1.ListIndex = 1 (et non plus -1)

Dans l'autre case de figure (doublons qui se suivent) ça ne fonctionne plus, la liste ne se remplit plus (!)

Donc, j'ai bien compris ce que tu m'as dit mais je m'interrogeais sur le pourquoi de ce "phénomène".

Mais si la seule solution consiste à activer la liste pour obtenir le hwnd afin d'utiliser la fonction SendMessage de l'Api de Windows de la librairie User32, avoue que pour gagner quelque dixièmes de seconde voire quelques centièmes... c'est beaucoup pour pas grand chose.
Et comme ici ce n'était qu'un souci d'élégance pour avoir une listbox sans doublon... je vais cesser de vous ennuyer.

Merci à tous de votre intérêt.

Je ne vais peut être pas délester cette discussion qui peut apporter des renseignements utiles... à ceux qui se posent des questions (...)

[ucfoutu]

Excuse-moi de ne pas avoir réussi à me rendre libre avant, Ousk...

Ce n'est pas un dixième de seconde, mais plus, que SendMessage permet de gagner sur une grande liste.

Voilà la solution avec API, donc.
Je n'ai pas eu le temps de la tester sous VBA (sur un autre PC), mais je pense qu'il n'y aura aucune différence avec ce que je viens de faire sous VB, puisque j'extrais le hwnd autrement qu'en me servant de ce que m'offre VB.

Un UserForm et un module

Sur le UserForm : une listbox nommée ListBox1 et un bouton de commande nommé Command1
et ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private ma_listbox_hwnd As Long
 
Private Sub Command1_Click()
  Dim a_ajouter  As String
  a_ajouter = "bananes"
  ret = SendMessage(ma_listbox_hwnd, LB_FINDSTRINGEXACT, 0, ByVal a_ajouter)
  If ret >= 0 Then
    MsgBox "refus d'ajout de ce doublon"
  Else
    Listbox1.AddItem a_ajouter
  End If
End Sub
 
Private Sub UserForm_Activate()
  ma_listbox_hwnd = trouve_hwnd(Listbox1, ActiveControl)
End Sub

Dans le modue, ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Option Explicit
Private Declare Function GetFocus Lib "User32" () As Long
Public Const LB_FINDSTRINGEXACT As Long = &H1A2
Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" _
         (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
 
 
Public Function trouve_hwnd(c0 As Object, c1 As Object) As Long
  If c1.Name = c0.Name Then trouve_hwnd = GetFocus(): Exit Function
  c0.SetFocus
  DoEvents
  trouve_hwnd = GetFocus()
  DoEvents
  c1.SetFocus
End Function

Il se peut que sous VBA tu aies à corriger as object par ce qui convient mieux et peut-être également ActiveControl (à voir, donc).

Tu lances et cliques sur command1 ===>> ajout de "bananes"
Clique une deuxième fois ==>> refus d'ajouter bananes en doublon
Voilà le principe et il est simple.

[ouskel'n'or]

Hello ucfoutu,
Bon, j'ai testé ça dans l'userform

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private ma_listbox_hwnd As Long
 
Private Sub UserForm_Activate()
Dim Cell As Range
    ListBox1.SetFocus
    ma_listbox_hwnd = trouve_hwnd(ListBox1, ActiveControl)
    For Each Cell In Worksheets("Feuil1").Range("A1:A" & Range("a" & Rows.Count).End(xlUp).Row)
        If SendMessage(ma_listbox_hwnd, LB_FINDSTRINGEXACT, 0, ByVal Cell) >= 0 Then _
           ListBox1.AddItem Cell
    Next Cell
End Sub

Je ne pense m'être trompé, cependant les doublons n'ont pas été supprimés, la liste reprenant l'intégralité des données de la colonne.
Tu vois une raison ?
J'ai testé Ret et j'obtiens toujours 0 (zéro) pour chaque donnée.
J'ai utilisé une variable string intermédiaire -> Même punition

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
        Donnée = Cell '(as string)
        If SendMessage(ma_listbox_hwnd, LB_FINDSTRINGEXACT, 0, ByVal Donnée) >= 0 Then _
           ListBox1.AddItem Cell

Bref, si tu as une explication, j'aime bien cette solution

Sinon, bonne journée et merci de t'être inquiété pour moi

[ucfoutu]

Bonjour, Ousk,

Mal dormi ?
Regarde mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
If ret >= 0 Then
    MsgBox "refus d'ajout de ce doublon"
  Else
    Listbox1.AddItem a_ajouter
  End If

On n'ajoute pas l'article si ce que l'on veut rajouter provoque un Ret >= 0 !!
et tu fais exactement le contraire avec ton :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
If SendMessage(ma_listbox_hwnd, LB_FINDSTRINGEXACT, 0, ByVal Cell) >= 0 Then _
           ListBox1.AddItem Cell

!!!

Change-moi vite ce >= par un < , hein ...


EDIT :

Attends, je vais faire en sorte que tu ne puisses pas te tromper :

Mets donc ceci dans un module :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Option Explicit
Private Declare Function GetFocus Lib "User32" () As Long
Private Const LB_FINDSTRINGEXACT As Long = &H1A2
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" _
         (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
 
 
Public Function trouve_hwnd(c0 As Object, c1 As Object) As Long
  If c1.Name = c0.Name Then trouve_hwnd = GetFocus(): Exit Function
  c0.SetFocus
  DoEvents
  trouve_hwnd = GetFocus()
  DoEvents
  c1.SetFocus
End Function
 
 
Public Sub ajouter_si_pas_doublon(c As Object, lehwnd As Long, ByVal quoi As String)
 Dim ret As Long
 ret = SendMessage(lehwnd, LB_FINDSTRINGEXACT, -0, ByVal quoi)
 If ret < 0 Then
    c.AddItem Trim(quoi)
  End If
End Sub

et mets ceci dans le code du UserForm :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Private ma_listbox_hwnd As Long
 
Private Sub UserForm_Activate()
    Dim Cell As Range, a_ajouter = as string, ma_listbox_hwnd as long
    a_ajouter = cell
    ListBox1.SetFocus
    ma_listbox_hwnd = trouve_hwnd(ListBox1, ActiveControl)
    doevents
    For Each Cell In Worksheets("Feuil1").Range("A1:A" & Range("a" & Rows.Count).End(xlUp).Row)
        ajouter_si_pas_doublon Listbox1, ma_listbox_hwnd, a_ajouter
    Next Cell
end sub

ma_listbox_hwnd = trouve_hwnd(Listbox1, ActiveControl)
End Sub[/CODE]

[ouskel'n'or]

Hello,
Oui, je t'ai mis le code testé en dernier ressort mais j'étais bien parti avec < 0

J'ai testé Ret et j'obtiens toujours 0 (zéro) pour chaque donnée

Bref, avec >= 0 ou < 0 même punition, sauf qu'avec < 0 je n'ai plus rien dans ma liste

Edit
Je suis allé voir SendMessage sur VB6 et ai complété l'appel à la fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Cell.Offset(0, 9) = SendMessage(ma_listbox_hwnd, _
LB_FINDSTRINGEXACT, ByVal ListBox1.ListIndex, ByVal Cell)

Même résultat, 0 pour chaque cellule
Une idée ?

[ucfoutu]

Mais que vient faire ici ce :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ByVal ListBox1.ListIndex

???
C'est 0, qu'il faut mettre là !!!
Ousk,

Je t'ai mis un code (mon edit) ne laisant aucune place à des modifs.
Applique-le tel quel !

EDIT :
Allons bon...
Je mets en route mon portable avec Excel et on va voir !:!!

[ouskel'n'or]

Ucfoutu, Je lis ce que tu mets, lis également ce que je mets. Merci.

Ton code tel que tu me l'as donné ne fonctionne pas. Ton zéro, je l'ai mis ! Ça ne fonctionne pas.
Je suis passé aux initiatives personnelles et au code proposé dans la FAQ à SendMessage qui s'applique pour un combo. D'où le "ByVal ListBox1.ListIndex"
Ça ne fonctionne pas mieux !
Voilà.
Je te laisse 10 secondes pour tester sur "ton" Excel

[ucfoutu]

Re,

Bon, je viens d'essayer et ça n'a pas marché.

Des différents tests que j'ai fait (utilisation d'une fonction pour le permettre), il appert que le problème n'est pas celui du raisonnement, ni du hwnd (qui est bon) mais celui de la constante LB_FINDSTRINGEXACT
Pour des raisons que j'ignore, cette constante n'est pas la même pour une Listbox de VB et pour une listbox de VBA ...
Intéressant, donc ! Il va falloir alors que je m'arme de patience pour faire des essais jusqu'à trouver la valeur à donner à cette constante pour une listbox de VBA.
Ca va être long et pénible (comme toujours dans ces cas-là), mais je ne manque pas d'opiniâtreté.

[ouskel'n'or]

Ucfoutu, je te prierai à l'avenir de ne proposer que des codes qui fonctionnent !
Blague à part, ne vas pas perdre ton temps à trouver une réponse. Si tu as mieux à faire, ce dont je ne doute pas, passe à autre chose, le problème n'est pas vital
Encore merci de tes efforts
Bon après-midi
A+