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 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237
| '*********************************************************
'** Sur un Form **
'** 2 ListBox nommées "ListE" indexées 0 et 1 **
'** 4 CmmandButton nommées "Cmds" indexées 0, 1, 2 et 3 **
'** 1 Label nommée "LabRequet" **
'*********************************************************
Option Explicit
Dim MemoList As String, MemoItem As Integer ' pour permettre le passage d'une ligne à une autre
Dim NlignselL1 As Integer ' drapeau numéro de ligne sélectionnée dans liste index 1, -1 signifiant qu'aucune ligne n'est sélectionnée
Dim Cpt As Integer ' pour permettre les boucles For .... Next et autres
Private Sub Form_Load()
Me.Height = 3075: Me.Width = 3630
ListE(0).Move 60, 60, 1215, 1590
ListE(0).ToolTipText = "Double cliquez pour faire passer d'une liste à l'autre"
ListE(0).Clear
ListE(0).AddItem "N° Cmd": ListE(0).ItemData(0) = 0
ListE(0).AddItem "Date émis.": ListE(0).ItemData(1) = 4
ListE(0).AddItem "Intitulé": ListE(0).ItemData(2) = 5
ListE(0).AddItem "Date récep.": ListE(0).ItemData(3) = 6
ListE(0).AddItem "FDT liée": ListE(0).ItemData(4) = 7
ListE(1).Move 2100, 60, 1215, 1590
ListE(1).ToolTipText = "Double cliquez pour faire passer d'une liste à l'autre, Touches fleche haute ou bas pour deplacer l'ordre de tri"
ListE(1).Clear: ListE(1).ForeColor = &HC00000
ListE(1).AddItem "Etat": ListE(1).ItemData(0) = 8
ListE(1).AddItem "Fournisseur": ListE(1).ItemData(1) = 1
ListE(1).AddItem "Emis par": ListE(1).ItemData(2) = 3
ListE(1).AddItem "Client": ListE(1).ItemData(3) = 2
Cmds(0).Move 1380, 60, 615, 315
Cmds(1).Move 1380, 420, 615, 315
Cmds(2).Move 1380, 960, 615, 315
Cmds(3).Move 1380, 1320, 615, 315
Cmds(0).Caption = ">------>"
Cmds(1).Caption = "<------<"
Cmds(2).Caption = "------>"
Cmds(3).Caption = "<------"
Cmds(2).Enabled = False: Cmds(3).Enabled = False
LabRequet.Caption = "": LabRequet.ForeColor = &HC00000
LabRequet.Move 60, 1800, 3195, 615
Redact ' pour exemple d'utilisation
End Sub
Private Function NLignselect(ObjetList As ListBox) As Integer
'routine pour savoir si une ligne est sélectionnée dans la liste passée en paramètre
Dim T As Integer, Num As Integer
Num = -1
For T = 0 To ObjetList.ListCount - 1
If ObjetList.Selected(T) = True Then Num = T: Exit For
Next T
NLignselect = Num
End Function
Private Sub GereCmds()
'gestion permissions d'action des boutons déplacement d'une liste à l'autre
If ListE(0).ListCount <> 0 Then
Cmds(0).Enabled = True: Cmds(2).Enabled = True
Else
Cmds(0).Enabled = False: Cmds(2).Enabled = False 'Liste vide
End If
If ListE(1).ListCount <> 0 Then
Cmds(1).Enabled = True: Cmds(3).Enabled = True
Else
Cmds(1).Enabled = False: Cmds(3).Enabled = False 'Liste vide
End If
If NLignselect(ListE(0)) = -1 Then
Cmds(2).Enabled = False 'aucune ligne n'étant sélectionnée
Else
Cmds(2).Enabled = True
End If
If NLignselect(ListE(1)) = -1 Then
Cmds(3).Enabled = False 'aucune ligne n'étant sélectionnée
Else
Cmds(3).Enabled = True
End If
End Sub
Private Sub Cmds_Click(Index As Integer)
Dim Cpt2 As Integer
Select Case Index
Case 0 'passage de toute la liste de gauche dans la liste de droite
For Cpt = ListE(0).ListCount - 1 To 0 Step -1
'copie de la ligne de la liste gauche dans la liste de droite
ListE(1).AddItem ListE(0).List(Cpt)
ListE(1).ItemData(ListE(1).NewIndex) = ListE(0).ItemData(Cpt)
Next Cpt
'supprime toutes les lignes de la liste de gauche
ListE(0).Clear
Case 1 'passage de toute la liste de droite dans la liste de gauche
For Cpt = ListE(1).ListCount - 1 To 0 Step -1
'copie de la ligne de la liste droite dans la liste de gauche
ListE(0).AddItem ListE(1).List(Cpt)
ListE(0).ItemData(ListE(0).NewIndex) = ListE(1).ItemData(Cpt)
Next Cpt
'supprime toutes les lignes de la liste de droite
ListE(1).Clear
Case 2 'passage de la ligne sélectionnée de la liste de gauche dans la liste de droite
' appel de la fonction recherche de ligne sélectionnée
Cpt = NLignselect(ListE(0)) 'de la liste gauche pour passage à la liste de droite
Cpt2 = NLignselect(ListE(1)) ' pour insertion à la liste de droite
' correction pour ajout en fin de liste si pas de sélection
If Cpt2 < 0 Then Cpt2 = ListE(1).ListCount
'copie de la ligne de la liste gauche dans la liste de droite
ListE(1).AddItem ListE(0).List(Cpt), Cpt2
ListE(1).ItemData(ListE(1).NewIndex) = ListE(0).ItemData(Cpt)
'supprime la ligne de la liste de gauche
ListE(0).RemoveItem Cpt
Case 3 'passage de la ligne sélectionnée de la liste de droite dans la liste de gauche
Cpt = NLignselect(ListE(1))
'copie de la ligne de la liste droite dans la liste de gauche
ListE(0).AddItem ListE(1).List(Cpt) 'ajout en fin de liste l'ordre pour cette liste n'important pas
ListE(0).ItemData(ListE(0).NewIndex) = ListE(1).ItemData(Cpt)
'supprime la ligne de la liste de droite
ListE(1).RemoveItem Cpt
End Select
GereCmds
Redact ' pour exemple d'utilisation
End Sub
Private Sub ListE_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Index = 1 Then
NlignselL1 = -1
If Button = 2 And ListE(1).ListIndex <> -1 Then
If ListE(1).Selected(ListE(1).ListIndex) = True Then
'desélection de la ligne par appuis du bouton droit de la souris
ListE(1).Selected(ListE(1).ListIndex) = False
End If
End If
If Button = 1 And ListE(1).ListIndex <> -1 Then
'récupération de la ligne sélectionnée par le bouton gauche de la souris
NlignselL1 = ListE(1).ListIndex
End If
End If
End Sub
Private Sub ListE_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Index = 1 And Button = 1 And NlignselL1 <> -1 Then
'gestion déplacements, dans la liste de droite, d'une ligne vers le haut ou le bas suivant le déplacement de la souris,
'bouton gauche de la souris enfoncé
If ListE(1).ListIndex <> NlignselL1 Then
'mémorisation des informations de la ligne en cours de sélection
MemoList = ListE(1).List(ListE(1).ListIndex)
MemoItem = ListE(1).ItemData(ListE(1).ListIndex)
'passe les informations de la ligne précédemment sélectionnée à la ligne en cours de sélection
ListE(1).List(ListE(1).ListIndex) = ListE(1).List(NlignselL1)
ListE(1).ItemData(ListE(1).ListIndex) = ListE(1).ItemData(NlignselL1)
'passe les informations mémorisées à la ligne précédemment sélectionnée
ListE(1).List(NlignselL1) = MemoList
ListE(1).ItemData(NlignselL1) = MemoItem
'mémorise le N° de ligne en cours de sélection pour le prochain changement de sélection de ligne
NlignselL1 = ListE(1).ListIndex
Redact ' pour exemple d'utilisation
End If
End If
End Sub
Private Sub ListE_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
GereCmds
End Sub
Private Sub ListE_DblClick(Index As Integer)
'Passage d'une ligne de la liste double cliquée à l'autre liste
If Index = 0 Then
'de liste gauche vers liste de droite
'rechercher si une ligne est sélectionnée dans ListE(1) pour l'insérer au dessus de la sélection si elle existe
Cpt = NLignselect(ListE(1)) ' appel de la fonction recherche de ligne sélectionnée
If Cpt = -1 Then Cpt = 0 'aucune ligne n'étant sélectionnée, l'insertion est faite en début de liste
'copie de la ligne de la liste gauche dans la liste de droite
ListE(1).AddItem ListE(0).List(ListE(0).ListIndex), Cpt
ListE(1).ItemData(ListE(1).NewIndex) = ListE(0).ItemData(ListE(0).ListIndex)
'supprime la ligne de la liste de gauche
ListE(0).RemoveItem ListE(0).ListIndex
Else
'de liste droite vers liste de gauche
'copie de la ligne de la liste droite dans la liste de gauche
ListE(0).AddItem ListE(1).List(ListE(1).ListIndex)
ListE(0).ItemData(ListE(0).NewIndex) = ListE(1).ItemData(ListE(1).ListIndex)
ListE(1).RemoveItem ListE(1).ListIndex
NlignselL1 = -1 'puisque la ligne a été supprimée, il n'y a plus de sélection, met le drapeau à valeur de ligne non sélectionnée
End If
Redact ' pour exemple d'utilisation
End Sub
Private Sub ListE_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If Index = 1 Then
'gestion déplacement de la ligne dans la liste de droite
If ListE(1).ListCount >= 2 Then
Select Case KeyCode
Case 38 'Up, flêche déplacement vers le haut
If ListE(1).ListIndex >= 1 Then
'mémorisation des informations de la ligne en cours de sélection
MemoList = ListE(1).List(ListE(1).ListIndex)
MemoItem = ListE(1).ItemData(ListE(1).ListIndex)
'passe les informations de la ligne juste au dessus de la ligne sélectionnée à la ligne en cours de sélection
ListE(1).List(ListE(1).ListIndex) = ListE(1).List(ListE(1).ListIndex - 1)
ListE(1).ItemData(ListE(1).ListIndex) = ListE(1).ItemData(ListE(1).ListIndex - 1)
'passe les informations mémorisées à la ligne juste au dessus de la ligne sélectionnée
ListE(1).List(ListE(1).ListIndex - 1) = MemoList
ListE(1).ItemData(ListE(1).ListIndex - 1) = MemoItem
End If
Case 40 'down, flêche deplacement vers le bas
If ListE(1).ListIndex <= ListE(1).ListCount - 2 Then
'mémorisation des informations de la ligne en cours de sélection
MemoList = ListE(1).List(ListE(1).ListIndex)
MemoItem = ListE(1).ItemData(ListE(1).ListIndex)
'passe les informations de la ligne juste au dessous de la ligne sélectionnée à la ligne en cours de sélection
ListE(1).List(ListE(1).ListIndex) = ListE(1).List(ListE(1).ListIndex + 1)
ListE(1).ItemData(ListE(1).ListIndex) = ListE(1).ItemData(ListE(1).ListIndex + 1)
'passe les informations mémorisées à la ligne juste au dessous de la ligne sélectionnée
ListE(1).List(ListE(1).ListIndex + 1) = MemoList
ListE(1).ItemData(ListE(1).ListIndex + 1) = MemoItem
End If
End Select
Redact ' pour exemple d'utilisation
End If
End If
End Sub
'***************************** Exemple rédaction d'une requête SQL ***************************************
Private Sub Redact()
Dim MsgReqt As String
For Cpt = 0 To ListE(1).ListCount - 1
MsgReqt = MsgReqt & ListE(1).List(Cpt)
If Cpt <> ListE(1).ListCount - 1 Then MsgReqt = MsgReqt & ", "
Next Cpt
LabRequet.Caption = "Select * From MaTable Order By " & MsgReqt
End Sub |
Partager