Synchronisation entre 2 listbox déterminées par macro
bonjour à tous et excellente année 2011 !
je voudrais synchroniser l'affichage entre 2 listboxes :
ListBoxArtDes (liste et désignation des articles)
et
ListBoxQte (qté de chaque article)
===
le souci (je suppose) est que ces 2 listboxes sont implémentées par 2 macros en fonction du choix fait dans une combobox, donc je ne peux définir les rowssource à l'initialisation du userform
===
j'ai testé les codes suivants :
1er code :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
| Private Sub ListBoxQte_Click()
With ListBoxArtDes
.TopIndex = ListBoxQte.TopIndex
.ListIndex = ListBoxQte.ListIndex
End With
End Sub
Private Sub ListBoxArtDes_Click()
With ListBoxQte
.TopIndex = ListBoxArtDes.TopIndex
.ListIndex = ListBoxArtDes.ListIndex
End With
End Sub |
2ème code :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
| Private Sub ListBoxArtDes_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
ListBoxQte.TopIndex = ListBoxArtDes.TopIndex
End Sub
Private Sub ListBoxQte_Change()
ListBoxArtDes.ListIndex = ListBoxQte.ListIndex
End Sub
Private Sub ListBoxArtDes_Change()
ListBoxQte.ListIndex = ListBoxArtDes.ListIndex
End Sub
Private Sub ListBoxQte_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
ListBoxArtDes.TopIndex = ListBoxQte.TopIndex
End Sub |
mais aucune synchronisation entre les listboxes
voici le code d'initialisation du formulaire :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
| Private Sub UserForm_Initialize()
With Sheets("CodesFeux")
Me.ComboBoxFeux.RowSource = .Name & "!" & .Range("A1:B" & .Range("A65536").End(xlUp).Row).Address
End With
With Sheets("articles")
Set RgComboBoxArticle1 = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
Set RgComboBoxArticle2 = .Range("B1:B" & .Range("B65536").End(xlUp).Row)
Set RgComboBoxArticle = .Range("A1:B" & .Range("B65536").End(xlUp).Row)
Set RgComboBoxQte = .Range("F1:F" & .Range("F65536").End(xlUp).Row)
Me.ComboBoxArticle.List = RgComboBoxArticle.Value
Me.ComboBoxQte.List = RgComboBoxQte.Value
End With
End Sub |
code pour remplir les listboxes :
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
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
| Private Sub ComboBoxFeux_Click()
Application.EnableEvents = False
Application.ScreenUpdating = False
Sheets("devis").Select
With ComboBoxFeux
TextBoxFeu.Text = .List(.ListIndex, 1)
End With
'quand on clique sur une valeur de la comboboxFeux,
'on affiche le détail qui compose le feu sélectionné
Dim ShF As Worksheet
Set ShF = Worksheets("feux")
Dim Feu As String
Feu = ComboBoxFeux.Value
On Error Resume Next
With ShF
'définir la zone de critère
'choisir l'étiquette de la colonne A1 --> champ où exploiter le filtre
.Range("I1") = .Range("A1")
.Range("I2") = Feu 'la valeur du critère du filtre
ShF.Range("K1").CurrentRegion.Clear
'définir la plage de cellules pour le filtre...
With .Range("A1:G" & .Range("A65536").End(xlUp).Row)
'application du filtre
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=ShF.Range("I1:I2"), _
CopyToRange:=ShF.Range("K1"), Unique:=False
'copie vers la cellule où débutera la plage résultat
End With
.ShowAllData
End With
Sheets("devis").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
Sheets("recupdevis").Select
Cells.Select
Selection.Copy
Sheets("devis").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("recupdevis").Select
Range("A1").Select
Application.CutCopyMode = False
Sheets("devis").Select
Range("A1").Select
Dim Rg As Range
With Worksheets("devis")
Set Rg = .Range("K1:K" & .Range("K65536").End(xlUp).Row)
End With
Do Until ActiveCell = ""
If ActiveCell = 0 Then
Selection.EntireRow.Delete Shift:=xlDown
Else
ActiveCell.Offset(1, 0).Range("A1").Select
End If
Loop
Sheets("articles").Select
Range("A1").Select
Dim DerLig As Long
'Feuil7 n'est pas le nom de l'onglet mais de la propriété NAME
'de la feuille visible seulement dans la fenêtre de l'éditeur de code.
With Feuil7
'si aucune donnée dans la feuille, sortie de la procédure.
If IsEmpty(.UsedRange) Then Exit Sub
'Trouver la dernière ligne où il y a des données
'dans les colonnes A:C (à adapter)
DerLig = .Range("A:K").Find(What:="*", _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Affectation de la plage de cellules à une variable objet Range
Set Rg = .Range("C1:C" & DerLig)
End With
With ComboBoxFeux
TextBoxTotalDevis = Sheets("devis").Range("I2").Value
End With
With Me.ListBoxFresque
' Nombre des colonnes du tableau ou plage de données
.ColumnCount = Rg.Columns.Count
'S'assure que l'on peut sélectionner plus d'une ligne à la fois
.MultiSelect = fmMultiSelectExtended
'largeur des colonnes dans le listbox
.ColumnWidths = "20"
'Remplir le listbox avec les données du tableau
.List = Rg.Value
'S'assure qu'aucune ligne de listbox n'est sélectionnée.
.ListIndex = -1
End With
'Feuil7 n'est pas le nom de l'onglet mais de la propriété NAME
'de la feuille visible seulement dans la fenêtre de l'éditeur de code.
With Feuil7
'si aucune donnée dans la feuille, sortie de la procédure.
If IsEmpty(.UsedRange) Then Exit Sub
'Trouver la dernière ligne où il y a des données
'dans les colonnes A:C (à adapter)
DerLig = .Range("A:K").Find(What:="*", _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Comme les données débutent en ligne 5, derlig ne peut pas être plus petit que 5
'Affectation de la plage de cellules à une variable objet Range
Set Rg = .Range("D1:D" & DerLig)
'résultat de la listbox
End With
With Me.ListBoxQte
' Nombre des colonnes du tableau ou plage de données
.ColumnCount = Rg.Columns.Count
'S'assure que l'on peut sélectionner plus d'une ligne à la fois
.MultiSelect = fmMultiSelectExtended
'largeur des colonnes dans le listbox
.ColumnWidths = "30"
'Remplir le listbox avec les données du tableau
.List = Rg.Value
'S'assure qu'aucune ligne de listbox n'est sélectionnée.
.ListIndex = -1
End With
With Feuil7
'si aucune donnée dans la feuille, sortie de la procédure.
If IsEmpty(.UsedRange) Then Exit Sub
'Trouver la dernière ligne où il y a des données
'dans les colonnes A:C (à adapter)
DerLig = .Range("A:K").Find(What:="*", _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Affectation de la plage de cellules à une variable objet Range
Set Rg = .Range("E1:F" & DerLig)
End With
With Me.ListBoxArtDes
' Nombre des colonnes du tableau ou plage de données
.ColumnCount = Rg.Columns.Count
'S'assure que l'on peut sélectionner plus d'une ligne à la fois
.MultiSelect = fmMultiSelectExtended
'largeur des colonnes dans le listbox
.ColumnWidths = "70"
'Remplir le listbox avec les données du tableau
.List = Rg.Value
'S'assure qu'aucune ligne de listbox n'est sélectionnée.
.ListIndex = -1
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub |
je suppose qu'il faut rajouter quelque chose dans l'initialisation mais je n'arrive pas à voir quoi ????
d'avance merci aux courageux du jour !
