interdire la sélection d'un item de la listebox1 si celui-ci ne figure pas dans la listbox2

piga25

XLDnaute Barbatruc
Bonjour le Forum

J'ai encore un petit soucis avec mes listbox.
J'aimerai qu'un message s'affiche lorsque l'on sélectionne un Item de la listbox Dest et que celui-ci ne figure pas dans la listBox Main. Par contre si l'item figure bien dans l'autre listbox on continu le code.

J'ai essayé ceci à partir d'un code qui me permet de faire une boucle sur les deux listebox et repérer les items qui ni figure pas.

VB:
Private Sub Dest_MouseUp1(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim i&, a&, n&
    For a = Me.Dest.ListCount - 1 To 0 Step -1
        For i = 0 To Me.Main.ListCount - 1
            If Me.Main.List(i, 0) = Me.Dest.List(a, 1) Then n = n + 1
        Next i
        If n = 0 Then Me.Dest.Selected(a) = True
        MsgBox " vous ne pouvez pas sélectionner ce sauveteur "
        n = 0
    Next a
End Sub

merci

Edit: La recherche doit se faire sur la colonne 0 de la listbox Main et sur la colonne 1 de la listbox Dest
 

youky(BJ)

XLDnaute Barbatruc
Bonjour Piga,
Essayes comme ceci.
Bruno
VB:
For i = 0 To Me.Main.ListCount - 1
            If Me.Main.List(i, 1) = Me.Dest.List(Dest.Listindex, 0) Then n = n + 1
Next i
if n=0 then
MsgBox " vous ne pouvez pas sélectionner ce sauveteur "
Dest.selected(Dest.listindex)=false
end if
 

piga25

XLDnaute Barbatruc
Bonjour youky, le forum

Désolé cela ne fonctionne pas
j'ai bien mis ce code
J'ai ajouté des commentaires pour voir si j'ai bien compris.

VB:
Private Sub Dest_MouseUp1(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim i&, a&, n&
    For a = Me.Main.ListCount - 1 To 0 Step -1 'boucle dans la listbox Main
      For i = 0 To Me.Main.ListCount - 1 'donne la valeur de i en partant de 0 au nb item de Main
        If Me.Main.List(i, 1) = Me.Dest.List(Dest.List.ListIndex, 0) Then n = n + 1 'vérifie la concordance entre les 2 listbox et indique avec n l'emplacement de l'item Dest à traiter
      Next i
        If n = 0 Then 'si item non trouvé alors affichage du msg
            MsgBox " vous ne pouvez pas sélectionner ce sauveteur "
            Dest.Selected(Dest.ListIndex) = False
        End If
    Next a
End Sub
 
Dernière édition:

youky(BJ)

XLDnaute Barbatruc
Hé non,
voici en entier, une seule boucle suffit.
Bruno
VB:
Private Sub Dest_MouseUp1(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim i&, n&
For i = 0 To Me.Main.ListCount - 1
'Main est en col 2 et Dest en col 1
            If Main.List(i, 1) = Dest.List(Dest.List.Listindex, 0) Then n = n + 1
Next i
if n=0 then
 MsgBox " vous ne pouvez pas sélectionner ce sauveteur "
Dest.selected(Dest.listindex)=false
end if
End sub
 

piga25

XLDnaute Barbatruc
Re

J'ai une erreur ici :
If Main.List(i, 1) = Dest.List(Dest.List.ListIndex, 0) Then n = n + 1
Nota: je fais la recherche sur le nom du sauveteur, celui-ci se trouve dans Main à la colonne 0 et dans la colonne 1 de Dest.
suivant ce que j'ai compris, on part de la colonne 0 puis 1, 2, 3 (là on a bien 4 colonne?)

Lorsque Main n'a pas d'item le code fonctionne bien
 

job75

XLDnaute Barbatruc
Bonjour piga25, Bruno,

Voyez le fichier joint et le code de l'USF :
VB:
Private Sub Dest_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim i&, t, j&, flag As Boolean
For i = 0 To Dest.ListCount - 1
    If Dest.Selected(i) Then
        t = Dest.List(i, 1) 'en 2ème colonne ???
        For j = 0 To Main.ListCount - 1
            If Main.List(j, 0) = t Then flag = True: Exit For
        Next j
        If Not flag Then
            Dest.Selected(i) = False 'désélectionne
            MsgBox "Vous ne pouvez pas sélectionner ce sauveteur" 'inutile, on voit bien que la sélection est impossible...
        End If
        flag = False
    End If
Next i
End Sub

Private Sub UserForm_Initialize()
Main.List = [A1:A4].Value
Dest.List = [C1:D4].Value
End Sub
La MsgBox me paraît inutile, mais bof si l'on y tient...

A+
 

Pièces jointes

  • USF(1).xlsm
    27.4 KB · Affichages: 6
Dernière édition:

job75

XLDnaute Barbatruc
Avec un Dictionary stocké dans une variable Public ce sera bien plus rapide :
VB:
Private Sub Dest_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim i&
For i = 0 To Dest.ListCount - 1
    If Dest.Selected(i) Then
        If Not d.exists(Dest.List(i, 1)) Then
            Dest.Selected(i) = False 'désélectionne
            MsgBox "Vous ne pouvez pas sélectionner ce sauveteur" 'inutile, on voit bien que la sélection est impossible...
        End If
    End If
Next i
End Sub
Fichier (2).
 

Pièces jointes

  • USF(2).xlsm
    28.2 KB · Affichages: 13

piga25

XLDnaute Barbatruc
Bonjour Job75, youky

Job: Parfait le code fonctionne.
si j'ai bien compris, lorsqu'il y a concordance entre les deux listbox, la variable flag passe à true et on poursuit dans la boucle. Si non concordance, on n'a pas flag, donc on met celle-ci à true ce qui persmet de déselectionner l'item et pour poursuivre on est obligé de repasser flag à false.
Youky: merci pour le code, cela m'a permis aussi d'apprendre.
 

youky(BJ)

XLDnaute Barbatruc
Bonsoir Piga,
Gérard,
Je pense qu'il n'est nul besoin de stocker en variable le sauveteur
Nous l'avons en Dest.List(Dest.List.Listindex, 1) ensuite une boucle sur l'autre liste pour tester si présent.
J'ai modifié le N° des colonnes Main et Dest de mon post précédent

VB:
Private Sub Dest_MouseUp1(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim i&, n&
For i = 0 To Me.Main.ListCount - 1
'Main est en col 1 et Dest en col 2
            If Main.List(i, 0) = Dest.List(Dest.List.Listindex, 1) Then n = n + 1
Next i
if n=0 then
 MsgBox " vous ne pouvez pas sélectionner ce sauveteur "
Dest.selected(Dest.listindex)=false
end if
End sub
Bruno
 

piga25

XLDnaute Barbatruc
Bonsoir Bruno
Le code fonctionne bien lorsqu'il ne trouve pas de correspondance. C'est bien ce que je souhaitais faire. Par contre lorsqu'il y a correspondance, là il y a erreur sur le ligne :
If Main.List(i, 0) = Dest.List(Dest.List.Listindex, 1) Then n = n + 1
Il faudrait peut être un Exit For pour i , voir quelque chose pour sortir de la boucle.
 

piga25

XLDnaute Barbatruc
Bonjour Bruno, Gérard, Eric, le Forum

Oui c'est vrai, mais le Dictionary peut être utile pour aller plus vite avec une liste "Main" beaucoup plus grande que la la lisre "Dest".
Oui cela est vrai, mais dans ce cas précis, cela ne sera pas utile. La liste "Main" sera toujours beaucoup plus courte que la liste "Dest".

ça ne serait pas plus ergonomique si tu remplissais Dest avec les seuls items possibles ?
Le principe du fichier est de situer la présence d'une personne dans un lieu précis, puis de le retranscrire sur une main courante. Au départ, j'ai une liste "Pref" modifiable. Dès qu'une personne arrive sur le site, elle est basculée sur la liste "Disponible". De là lorsqu'elle est employée, elle est redirigée vers la liste "Départ PC". Là plusieurs cas possibles, si elle reste en surface, elle ne bouge pas de cette liste. Par contre si elle va sous-terre, elle entre dans la liste "Entrée cavité". La même chose se produit pour le sens inverse.
En plus de cela, j'ai deux autres listes, la liste "Historique" qui elle enregistre tous les mouvements à la suite des uns et des autres, puis la liste "Main". Cette dernière me permet d'enregistrer le ou les derniers mouvements de personnel et cela tant qu'ils ne sont pas inscrit sur la main courante. Dès que cela est fait, cette liste se vide. C'est pour cette raison qu'elle est plus courte.
Le problème que j'avais, c'était de pouvoir revenir en arrière lors de cette opération, c'est à dire pouvoir retirer une personne si on s'était trompé de nom, et comme la liste "Dest" est plus importante que la liste "Main" je voulais pouvoir sélectionner uniquement les noms qui figurent sur ces deux listes.

Au final, je pense encore mettre d'autres listes, et ceci afin de pouvoir affiner au mieux la position des personnes, vaste projet qui je pense va encore vous mettre à contribution.
Je réalise cela par plaisir, pour apprendre et surtout pour rendre service à mes amis collègues spéléos.

En tous cas je vous remercie tous pour l'aide que vous m'apportez et que vous m'apporterez. Sans vous je n'en serai pas là. Merci.:);)
 

youky(BJ)

XLDnaute Barbatruc
Bonjour tous,
J'ai repris le fichier de Job75 et modifié à ma façon.
Comme j'avais écrit la macro avec le bloc-note la boulette était pas loin (j'avais List en trop)
Et si j'ai bien compris
Bruno
 

Pièces jointes

  • USF(2) (1).xlsm
    19.7 KB · Affichages: 10

Discussions similaires

Statistiques des forums

Discussions
312 201
Messages
2 086 168
Membres
103 151
dernier inscrit
nassim