Boite de dialogue avec liste déroulante

**wyzer** · 24/10/2011, 15h56

Bonjour,

J'aimerais intégrer dans une Macro l'affichage d'une boite de dialogue avec une liste déroulante, mais je vais d'abord vous expliquez le fonctionnement de ma macro

- l’utilisateur sélectionne un fichier TXT à traiter
- les donnés du fichier TXT sont stocké dans un tableau "tb"
- le fichier TXT peut contenir plusieurs société différentes, donc on effectue un listing
- on alimente la liste déroulante de la boite de dialogue avec le listing
- on affiche la boite de dialogue à l'utilisateur afin qu'il séléctionne la société qui l'intéresse, ou il peut cocher une case "Tout", puis il clique sur OK
- et en fonction du choix, la macro va exécuter une action spécifique

J'espère que j'ai été clair

Merci par avance

**jfontaine** · 24/10/2011, 16h06

Bonjour,

L'énoncé est clair.

Mais tu bloques ou

**wyzer** · 24/10/2011, 17h01

Ce que je ne sais pas faire c'est utiliser les boites de dialogues avec une liste déroulante. Je n'ai jamais utiliser ça
Ensuite, comment faire pour alimenter la liste déroulante avec un tableau dont les données varieront à chaque lancement de la macro, puis récupérer le choix de l'utilisateur ?

**jfontaine** · 24/10/2011, 20h46

Ci dessous un exemple avec les composants ActiveX

Tu creais une Userform et positionne un Combobox et un Bouton
Nom : userform.jpg
Affichages : 6670
Taille : 7,1 Ko

Nom : userform.jpg
Affichages : 6670
Taille : 7,1 Ko

Tu alimentes la combobox dans l'evenement Initialize (ici on alimente avec le nom des mois)

Code :

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

1
2
3
4
5
6
7
8
Private Sub UserForm_Initialize()
Dim i As Byte
 
For i = 1 To 12
    ComboBox1.AddItem MonthName(i)
Next i
 
End Sub

On déclare une variable de retour dans un module

Code :

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

Public StrMois As String

Cette variable sera alimentée par l'évenement Click du bouton (Le bouton provoquera aussi la sortie de la Userform)

Code :

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

1
2
3
4
Private Sub CommandButton1_Click()
StrMois = ComboBox1.Text
Unload Me
End Sub

On termine pas l'appel de la userform

Code :

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

1
2
3
4
5
6
7
Sub ChoixMois()
 
UserForm1.Show
 
MsgBox StrMois
 
End Sub

**wyzer** · 26/10/2011, 11h47

Merci !!

En revanche je bloque sur un petit truc :

Etant donné que ma Macro est dans un module et que le code de la ComboBox est dans un UserForm, comment créer un lien entre les deux ?

Car vers le milieu de ma Macro, les données qui alimenteront la ComBoX sont stockées dans un tableau nommé "tb"

J'ai voulu mettre "Call ComBox" mais ça ne fonctionne pas
Et même si ça fonctionnait, le fait de sortir du module, mon "tb" n'existe plus

**jfontaine** · 26/10/2011, 12h21

Et même si ça fonctionnait, le fait de sortir du module, mon "tb" n'existe plus

Vérifie la portée de ta variable. Si elle est déclaré en PUBLIC elle doit être accessible dans la userform

Pour le reste impossible de te dire sans voir ton code

**wyzer** · 26/10/2011, 13h40

Ah j'avais pas mis "Public sub", je vais ré-essayer

Voilà mon 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
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
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
Option Explicit
Option Base 1
 
Sub Partenaires()
Application.ScreenUpdating = False
 
Dim TextLine As String, trame As Workbook
Dim i As Long, j As Long, dl As Long, wb As Workbook
Dim OuvrirFichiers As Variant, tb(10000, 38) As Variant, tb2 As Variant, tb3 As Variant
 
i = 0
 
OuvrirFichiers = Application.GetOpenFilename("Tous les fichiers (*.*),*.*")
 
If OuvrirFichiers = False Then
    Exit Sub
End If
 
Open OuvrirFichiers For Input As #1
 
Do While Not EOF(1)
    i = i + 1
    Line Input #1, TextLine
    If Mid(TextLine, 1, 1) = "1" Then 'En-tête fichier
        tb(i, 1) = Mid(TextLine, 1, 1)
        tb(i, 2) = Mid(TextLine, 2, 8)
        tb(i, 3) = Mid(TextLine, 10, 30)
        tb(i, 4) = Mid(TextLine, 40, 1)
        tb(i, 5) = Mid(TextLine, 41, 3)
    End If
    If Mid(TextLine, 1, 1) = "2" Then 'En-tête commande
        tb(i, 1) = Mid(TextLine, 1, 1)
        tb(i, 2) = Mid(TextLine, 2, 5)
        tb(i, 3) = Mid(TextLine, 7, 32)
        tb(i, 4) = Mid(TextLine, 39, 20)
        tb(i, 5) = Mid(TextLine, 59, 20)
        tb(i, 6) = Mid(TextLine, 79, 32)
        tb(i, 7) = Mid(TextLine, 111, 14)
        tb(i, 8) = Mid(TextLine, 125, 5)
        tb(i, 9) = Mid(TextLine, 130, 32)
        tb(i, 10) = Mid(TextLine, 162, 32)
        tb(i, 11) = Mid(TextLine, 194, 32)
        tb(i, 12) = Mid(TextLine, 226, 5)
        tb(i, 13) = Mid(TextLine, 231, 26)
        tb(i, 14) = Mid(TextLine, 257, 11)
        tb(i, 15) = Mid(TextLine, 268, 11)
        tb(i, 16) = Mid(TextLine, 279, 1)
        tb(i, 17) = Mid(TextLine, 280, 2)
 
    End If
    If Mid(TextLine, 1, 1) = "3" Then 'En-tête succursales
        tb(i, 1) = Mid(TextLine, 1, 1)
        tb(i, 2) = Mid(TextLine, 2, 5)
        tb(i, 3) = Mid(TextLine, 7, 3)
        tb(i, 4) = Mid(TextLine, 10, 15)
        tb(i, 5) = Mid(TextLine, 25, 32)
        tb(i, 6) = Mid(TextLine, 57, 32)
        tb(i, 7) = Mid(TextLine, 89, 32)
        tb(i, 8) = Mid(TextLine, 121, 32)
        tb(i, 9) = Mid(TextLine, 153, 5)
        tb(i, 10) = Mid(TextLine, 158, 26)
        tb(i, 11) = Mid(TextLine, 184, 20)
 
    End If
    If Mid(TextLine, 1, 1) = "4" Then 'En-tête carnet
        tb(i, 1) = Mid(TextLine, 1, 1)
        tb(i, 2) = Mid(TextLine, 2, 5)
        tb(i, 3) = Mid(TextLine, 7, 3)
        tb(i, 4) = Mid(TextLine, 10, 4)
        tb(i, 5) = Mid(TextLine, 14, 5)
        tb(i, 6) = Mid(TextLine, 19, 15)
        tb(i, 7) = Mid(TextLine, 34, 1)
        tb(i, 8) = Mid(TextLine, 35, 32)
        tb(i, 9) = Mid(TextLine, 67, 32)
        tb(i, 10) = Mid(TextLine, 99, 8)
        tb(i, 11) = Mid(TextLine, 107, 4)
        tb(i, 12) = Mid(TextLine, 111, 1)
        tb(i, 13) = Mid(TextLine, 112, 4)
        tb(i, 14) = Mid(TextLine, 116, 27)
        tb(i, 15) = Mid(TextLine, 143, 38)
        tb(i, 16) = Mid(TextLine, 181, 38)
        tb(i, 17) = Mid(TextLine, 219, 5)
        tb(i, 18) = Mid(TextLine, 224, 32)
        tb(i, 19) = Mid(TextLine, 256, 5)
        tb(i, 20) = Mid(TextLine, 261, 32)
        tb(i, 21) = Mid(TextLine, 293, 15)
        tb(i, 22) = Mid(TextLine, 308, 15)
        tb(i, 23) = Mid(TextLine, 323, 15)
        tb(i, 24) = Mid(TextLine, 338, 150)
        tb(i, 25) = Mid(TextLine, 488, 1)
        tb(i, 26) = Mid(TextLine, 489, 32)
        tb(i, 27) = Mid(TextLine, 521, 32)
        tb(i, 28) = Mid(TextLine, 553, 4)
        tb(i, 29) = Mid(TextLine, 557, 1)
        tb(i, 30) = Mid(TextLine, 558, 4)
        tb(i, 31) = Mid(TextLine, 562, 27)
        tb(i, 32) = Mid(TextLine, 589, 38)
        tb(i, 33) = Mid(TextLine, 627, 38)
        tb(i, 34) = Mid(TextLine, 665, 5)
        tb(i, 35) = Mid(TextLine, 670, 32)
        tb(i, 36) = Mid(TextLine, 702, 173)
        tb(i, 37) = Mid(TextLine, 875, 1)
        tb(i, 38) = Mid(TextLine, 876, 20)
    End If
    If Mid(TextLine, 1, 1) = "5" Then 'Typologie titre
        tb(i, 1) = Mid(TextLine, 1, 1)
        tb(i, 2) = Mid(TextLine, 2, 5)
        tb(i, 3) = Mid(TextLine, 7, 3)
        tb(i, 4) = Mid(TextLine, 10, 4)
        tb(i, 5) = Mid(TextLine, 14, 2)
        tb(i, 6) = Mid(TextLine, 16, 5)
        tb(i, 7) = Mid(TextLine, 21, 5)
        tb(i, 8) = Mid(TextLine, 26, 8)
        tb(i, 9) = Mid(TextLine, 34, 3)
        tb(i, 10) = Mid(TextLine, 37, 3)
        tb(i, 11) = Mid(TextLine, 40, 40)
    End If
    If Mid(TextLine, 1, 1) = "6" Then 'Pied carnet
        tb(i, 1) = Mid(TextLine, 1, 1)
        tb(i, 2) = Mid(TextLine, 2, 7)
        tb(i, 3) = Mid(TextLine, 9, 11)
    End If
    If Mid(TextLine, 1, 1) = "7" Then 'Pied succursale
        tb(i, 1) = Mid(TextLine, 1, 1)
        tb(i, 2) = Mid(TextLine, 2, 7)
        tb(i, 3) = Mid(TextLine, 9, 11)
        tb(i, 4) = Mid(TextLine, 20, 11)
        tb(i, 5) = Mid(TextLine, 31, 9)
    End If
    If Mid(TextLine, 1, 1) = "8" Then 'Pied commande
        tb(i, 1) = Mid(TextLine, 1, 1)
        tb(i, 2) = Mid(TextLine, 2, 7)
        tb(i, 3) = Mid(TextLine, 9, 11)
        tb(i, 4) = Mid(TextLine, 20, 11)
        tb(i, 5) = Mid(TextLine, 31, 9)
    End If
    If Mid(TextLine, 1, 1) = "9" Then 'Pied fichier
        tb(i, 1) = Mid(TextLine, 1, 1)
        tb(i, 2) = Mid(TextLine, 2, 7)
    End If
Loop
 
dl = i
ReDim tb2(dl, 38)
tb2 = tb
Erase tb
 
Close #1
 
'###########################################################################################################
 
For i = 1 To dl 'Suppression des espaces
    For j = 1 To 38
        tb2(i, j) = Trim(tb2(i, j))
    Next j
Next i
For i = 1 To dl 'Civilité
    If tb2(i, 1) = "4" Then
        If tb2(i, 7) = "1" Then
            tb2(i, 7) = "M."
        ElseIf tb2(i, 7) = "2" Then
            tb2(i, 7) = "Mme"
        ElseIf tb2(i, 7) = "3" Then
            tb2(i, 7) = "Mlle"
        End If
    End If
Next
For i = 1 To dl 'Date de naissance
    If tb2(i, 1) = "4" Then
        tb2(i, 10) = Mid(tb2(i, 10), 1, 2) & "/" & Mid(tb2(i, 10), 3, 2) & "/" & Mid(tb2(i, 10), 5, 4)
        tb2(i, 10) = DateValue(tb2(i, 10))
    End If
Next
For i = 1 To dl 'Déplacement adresse si "Nom de la voie" vide
    If tb2(i, 1) = "4" Then
        If tb2(i, 14) = "" Then
           tb2(i, 14) = tb2(i, 15)
           tb2(i, 15) = tb2(i, 16)
        Else
            tb2(i, 15) = tb2(i, 15) & " " & tb2(i, 16)
        End If
    End If
Next
For i = 1 To dl 'Correction e-mail
    If tb2(i, 1) = "4" And tb2(i, 24) <> "" Then
        tb2(i, 24) = Replace(tb2(i, 24), ",", ".")
    End If
Next
For i = 1 To dl 'VN
    If tb2(i, 1) = "5" Then
        tb2(i, 6) = tb2(i, 6) / 100
    End If
Next
For i = 1 To dl 'Part financeur
    If tb2(i, 1) = "5" Then
        tb2(i, 7) = tb2(i, 7) / 100
    End If
Next
 
'###########################################################################################################
 
 
j = 1
 
For i = 1 To UBound(tb2, 1) 'on récupère la liste des entreprises
    If tb2(i, 1) = "2" Then
        tb4(j) = tb2(i, 3)
        j = j + 1
    End If
Next
 
'ici il y aura la boite de dialogue
 
 
'###########################################################################################################
 
If tb2(1, 5) = "002" Then
    Set trame = Workbooks.Open("S:\SERVICE CLIENT\MACROS\MODELES\Trame_CESU_CM.xls")
ElseIf tb2(1, 5) = "003" Then
    Set trame = Workbooks.Open("S:\SERVICE CLIENT\MACROS\MODELES\Trame_CESU_CIC.xls")
End If
 
With trame.Sheets("Commande")
    ReDim tb3(dl, 17)
    j = 1
    For i = 1 To dl
        If tb2(i, 1) = "4" Then
            tb3(j, 1) = tb2(i, 3) 'Succursale
            tb3(j, 2) = tb2(i, 7) 'Civ
            tb3(j, 3) = tb2(i, 8) 'Nom
            tb3(j, 4) = tb2(i, 9) 'Prénom
            tb3(j, 5) = tb2(i, 10) 'Date naissance
            tb3(j, 6) = tb2(i + 1, 5) 'Nb chèques
            tb3(j, 7) = tb2(i + 1, 6) 'Valeur chèques
            tb3(j, 8) = tb2(i + 1, 7) 'Part financeur
            tb3(j, 9) = tb2(i, 11) 'N°
            tb3(j, 10) = tb2(i, 12) 'Bis/Ter
            tb3(j, 11) = tb2(i, 13) 'Type
            tb3(j, 12) = tb2(i, 14) 'Voie
            tb3(j, 13) = tb2(i, 15) 'Complément
            tb3(j, 14) = tb2(i, 17) 'CP
            tb3(j, 15) = tb2(i, 18) 'Ville
            tb3(j, 16) = tb2(i, 6) 'Matricule
            tb3(j, 17) = tb2(i, 24) 'E-Mail
            j = j + 1
        End If
    Next
    For i = 1 To dl 'Suppression des zéros
        If tb3(i, 9) = 0 Then
            tb3(i, 9) = ""
        End If
    Next
    .Range("b21:r" & dl + 18).Value = tb3
    .Range("e9").Value = tb2(2, 3) 'Raison sociale
    .Range("j9").Value = tb2(2, 2) 'Code client
    If Not tb2(2, 2) = "" Then 'Clé
        .Range("j10").Value = .Range("m9").Value
    End If
    .Range("e12").Value = Date
    Erase tb2
    Erase tb3
End With
 
Application.ScreenUpdating = True
End Sub

EDIT : ma boite de dialogue sera placé à la ligne 212

**wyzer** · 26/10/2011, 14h42

C'est bon ça fonctionne !!

En fait il fallait que je mette le code qui initialise ma ComBox1 dans mon module

Merci encore !!

Boite de dialogue avec liste déroulante

Macros et VBA Excel

Discussions similaires

Partager

Partager