Listbox afficher une colonne et, après une recherche, additionner les valeurs de cette colonne dans un label

**goninph** · 22/07/2020, 18h18

Bonjour,

J'ai un formulaire avec cette listbox qui liste les 3 premières colonnes de mon tableau Excel.

J'aimerai lister une 4ᵉ colonne, la colonne N°45 de mon fichier Excel contenant des sommes en CHF, mais je n'arrive pas à adapter le code d'initialisation.

Dans un deuxième temps, lors de la recherche avec TextBox1_Change, j'aimerai additionner les valeurs de la colonne N°45 des lignes trouvées par la recherche et afficher l'addition dans un label

Est-ce possible ?

Merci et meilleures salutations
Philippe

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
Private Sub UserForm_Initialize()
Dim LargeurCol()
    'TextBox1 est une ComboBox pour éviter de remplacer le texte
    Me.TextBox1.List = Array( _
    "A_planifier_dépannage", _
    "A_planifier_réparations", _
    "A_planifier En ville", _
    "A_planifier Zone-1", _
    "A_planifier Zone-2", _
    "A_planifier Zone-3", _
    "A_planifier Zone-4", _
    "A_planifier_livraison_1_tech.", _
    "A_planifier_livraison_2_tech.", _
    "A_planifier", _
    "Livraison", _
    "Dépannage", _
    "Devis_en_cours", _
    "En_commande", _
    "Réparations_client", _
    "Réparations_atelier", _
    "A_facturer", _
    "Terminer")
    Set f = Sheets("DATA_Interventions")
    Set Rng = f.Range("A3:E" & f.[A65000].End(xlUp).Row) 'Dernière colonne, indiquer au minimum la colonne suivante : pour afficher F indiquer E
    Me.ListBox1.ColumnCount = 3
    colVisu = Array(1, 2, 3) 'Numéros des colonnes à afficher
    LargeurCol = Array(0, 0, 1700) 'largeur des colonnes, 0 pour masquer l'ID et l'adresse de la ligne Data
    Me.ListBox1.ColumnWidths = Join(LargeurCol, ";")
    colInterro = Array(3) 'Numéros des colonnes de la feuille DATA dans lesquels rechercher
    Decal = Rng.Row - 1 'Début de la base de donnée
    BD = Rng.Value
    Col = UBound(BD, 2): For i = LBound(BD) To UBound(BD): BD(i, Col) = i + Decal: Next i 'no enreg
    NcolInt = UBound(colInterro) + 1
    Ncol = UBound(colVisu) + 1 'ReDim ancien(1 To 1, 1 To Ncol)
    'Génération de choix()
    ReDim choix(1 To UBound(BD))
    Col = UBound(BD, 2)
    For i = LBound(BD) To UBound(BD)
        For Each k In colInterro
            choix(i) = choix(i) & BD(i, k) & "|"
        Next k
        choix(i) = choix(i) & BD(i, Col) & "|" 'no enreg
    Next i
        TriS choix, 1, UBound(choix)
        'Valeurs initiales dans ListBox
        Dim Tbl(): ReDim Tbl(1 To UBound(BD), 1 To Ncol + 1)
        For i = 1 To UBound(BD)
        c = 0
            For Each k In colVisu
                c = c + 1: Tbl(i, c) = BD(i, k)
            Next k
        c = c + 1: Tbl(i, c) = i + Decal
    Next i
    TriMultiCol Tbl, 1, LBound(Tbl), UBound(Tbl)
    Me.ListBox1.List = Tbl
    Me.ListBox1.ListIndex = -1
    Me.TextBox1 = " " 'Initialisation avec un espace pour déclencher le tri de la colonne 3 du USF
    'Exemple : Ci-dessous l'espace est situé entre les 2 ComboBox
    'Me.TextBox1 = USF_Intervention.ComboBox_Interv_Nom & " " & USF_Intervention.ComboBox_Interv_Prenom
    Me.TextBox1.SetFocus 'Placer le curseur dans la recherche
End Sub
Private Sub TextBox1_Change()
    If Me.TextBox1 <> "" Then
        Mots = Split(Trim(Me.TextBox1), " ")
        Tbl = choix
        For i = LBound(Mots) To UBound(Mots)
            Tbl = Filter(Tbl, Mots(i), True, vbTextCompare)
        Next i
        If UBound(Tbl) > -1 Then
            Dim b(): ReDim b(1 To UBound(Tbl) + 1, 1 To Ncol + 1)
            For i = LBound(Tbl) To UBound(Tbl)
                a = Split(Tbl(i), "|")
                j = a(NcolInt) - 1 - Decal + 1
                For k = 1 To Ncol
                    kk = colVisu(k - 1)
                    xx = UBound(BD)
                    b(i + 1, k) = BD(j, kk)
                Next k
                b(i + 1, k) = j + 1
            Next i
            Me.ListBox1.List = b
        Else
            Me.ListBox1.Clear
        End If
        Me.Label_Nombre_trouve.Caption = "Trouvé : " & UBound(Tbl) + 1
    Else
        UserForm_Initialize 'Ne pas initializer si textbox vide car recharge les données du nom et du prénom
    End If
End Sub
Sub TriMultiCol(a, ColTri, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2, ColTri)
  g = gauc: d = droi
  Do
    Do While a(g, ColTri) < ref: g = g + 1: Loop
    Do While ref < a(d, ColTri): d = d - 1: Loop
    If g <= d Then
      For k = LBound(a, 2) To UBound(a, 2)
        temp = a(g, k): a(g, k) = a(d, k): a(d, k) = temp
      Next k
      g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call TriMultiCol(a, ColTri, g, droi)
  If gauc < d Then Call TriMultiCol(a, ColTri, gauc, d)
End Sub
Sub TriS(a, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
     Do While a(g) < ref: g = g + 1: Loop
     Do While ref < a(d): d = d - 1: Loop
     If g <= d Then
        temp = a(g): a(g) = a(d): a(d) = temp
        g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droi Then Call TriS(a, g, droi)
   If gauc < d Then Call TriS(a, gauc, d)
End Sub

**ARTURO83** · 23/07/2020, 09h46

Bonjour,

Difficile de vous répondre sans connaître votre fichier
je dirai pour la question 1, mais sans garantie

Code :

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

1
2
3
4
5
6
7
    Set f = Sheets("DATA_Interventions")
    Set Rng = f.Range("A3:AT" & f.Range("A" & Rows.Count).End(xlUp).Row) 'Dernière colonne, indiquer au minimum la colonne suivante : pour afficher 45 indiquer 46 soit "AT"
    Me.ListBox1.ColumnCount = 4
    colVisu = Array(1, 2, 3, 45) 'Numéros des colonnes à afficher
    LargeurCol = Array(0, 0, 1700) 'largeur des colonnes, 0 pour masquer l'ID et l'adresse de la ligne Data
    Me.ListBox1.ColumnWidths = Join(LargeurCol, ";")
    colInterro = Array(3, 45) 'Numéros des colonnes de la feuille DATA dans lesquels rechercher

Pour la question2:
Vous pouvez adoptez l'une des 2 fonctions

Code :

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

1
2
    somme=application.WorksheetFunction.SumProduct(    )
    somme=application.WorksheetFunction.SumIfs(    )

et copier le résultat dans la TextBox

C'est tout ce que je peux vous proposer, en espérant que cela puisse vous aider.

Cdlt

**goninph** · 23/07/2020, 12h44

Bonjour,

Merci pour votre aide, mais j'ai une erreur d'exécution 9 avec ce code

en pièce jointe le fichier contenant la listbox : Listbox.xlsm

Code :

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

1
2
3
4
5
6
7
    Set f = Sheets("DATA_Interventions")
    Set Rng = f.Range("A3:AT" & f.Range("A" & Rows.Count).End(xlUp).Row) 'Dernière colonne, indiquer au minimum la colonne suivante : pour afficher 45 indiquer 46 soit "AT"
    Me.ListBox1.ColumnCount = 4
    colVisu = Array(1, 2, 3, 45) 'Numéros des colonnes à afficher
    LargeurCol = Array(0, 0, 1700) 'largeur des colonnes, 0 pour masquer l'ID et l'adresse de la ligne Data
    Me.ListBox1.ColumnWidths = Join(LargeurCol, ";")
    colInterro = Array(3, 45) 'Numéros des colonnes de la feuille DATA dans lesquels rechercher

J'ai ajouté cette ligne de code :
Me.Label_Somme_CHF = Application.WorksheetFunction.SumProduct(Sheets("DATA_Interventions").Range("AS3:AS1048576"))

dans

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
Private Sub TextBox1_Change()
    If Me.TextBox1 <> "" Then
        Mots = Split(Trim(Me.TextBox1), " ")
        Tbl = choix
        For i = LBound(Mots) To UBound(Mots)
            Tbl = Filter(Tbl, Mots(i), True, vbTextCompare)
        Next i
        If UBound(Tbl) > -1 Then
            Dim b(): ReDim b(1 To UBound(Tbl) + 1, 1 To Ncol + 1)
            For i = LBound(Tbl) To UBound(Tbl)
                a = Split(Tbl(i), "|")
                j = a(NcolInt) - 1 - Decal + 1
                For k = 1 To Ncol
                    kk = colVisu(k - 1)
                    xx = UBound(BD)
                    b(i + 1, k) = BD(j, kk)
                Next k
                b(i + 1, k) = j + 1
            Next i
            Me.ListBox1.List = b
        Else
            Me.ListBox1.Clear
        End If
        Me.Label_Nombre_trouve.Caption = "Trouvé : " & UBound(Tbl) + 1
    Else
        UserForm_Initialize 'Ne pas initializer si textbox vide car recharge les données du nom et du prénom
    End If
    Me.Label_Somme_CHF = Application.WorksheetFunction.SumProduct(Sheets("DATA_Interventions").Range("AS3:AS1048576"))
End Sub

Mais la somme ne varie pas lors d'une recherche, ce qui parrait normal, mais comment faire pour afficher la somme des interventions affichées dans la listbox après une recherche avec la textbox ?

**ARTURO83** · 23/07/2020, 16h52

Si ce n'est que pour obtenir la somme des montants en fonction du choix de la textbox1, alors (sans toucher à la partie initialisation du formulaire)

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
Private Sub TextBox1_Change()
    If Me.TextBox1 <> "" Then
        Mots = Split(Trim(Me.TextBox1), " ")
        Tbl = choix
        For i = LBound(Mots) To UBound(Mots)
            Tbl = Filter(Tbl, Mots(i), True, vbTextCompare)
        Next i
        If UBound(Tbl) > -1 Then
            Dim b(): ReDim b(1 To UBound(Tbl) + 1, 1 To Ncol + 1)
            For i = LBound(Tbl) To UBound(Tbl)
                a = Split(Tbl(i), "|")
                j = a(NcolInt) - 1 - Decal + 1
                For k = 1 To Ncol
                    kk = colVisu(k - 1)
                    xx = UBound(BD)
                    b(i + 1, k) = BD(j, kk)
                Next k
                b(i + 1, k) = j + 1
            Next i
            Me.ListBox1.List = b
        Else
            Me.ListBox1.Clear
        End If
        Me.Label_Nombre_trouve.Caption = "Trouvé : " & UBound(Tbl) + 1
    Else
        UserForm_Initialize 'Ne pas initializer si textbox vide car recharge les données du nom et du prénom
    End If
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    Label_montant_CHF = Application.WorksheetFunction.SumIf(Range("Q3:Q" & DerLig), TextBox1.Text, Range("AS3:AS" & DerLig))
End Sub

Cdlt

**goninph** · 23/07/2020, 18h04

merci pour cette solution

En cherchant j'ai trouvé ceci :

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
Private Sub TextBox1_Change()
    If Me.TextBox1 <> "" Then
        Mots = Split(Trim(Me.TextBox1), " ")
        Tbl = choix
        For i = LBound(Mots) To UBound(Mots)
            Tbl = Filter(Tbl, Mots(i), True, vbTextCompare)
        Next i
        If UBound(Tbl) > -1 Then
            Dim b(): ReDim b(1 To UBound(Tbl) + 1, 1 To Ncol + 1)
            For i = LBound(Tbl) To UBound(Tbl)
                a = Split(Tbl(i), "|")
                j = a(NcolInt) - 1 - Decal + 1
                For k = 1 To Ncol
                    kk = colVisu(k - 1)
                    xx = UBound(BD)
                    b(i + 1, k) = BD(j, kk)
                Next k
                b(i + 1, k) = j + 1
            Next i
            Me.ListBox1.List = b
            
        Else
            Me.ListBox1.Clear
        End If
        Me.Label_Nombre_trouve.Caption = "Trouvé : " & UBound(Tbl) + 1
    Else
        UserForm_Initialize 'Ne pas initializer si textbox vide car recharge les données du nom et du prénom
    End If
    On Error Resume Next
    Me.Label_Somme_CHF = "CHF  " & format(Application.Sum(Application.index(Me.ListBox1.List, , 3)), "0 000.00") & " TTC"
End Sub

**goninph** · 23/07/2020, 19h31

Voilà, avec votre aide je suis à bout touchant.

Comment ajouter 2 décimales aux sommes de la colonne CHF TTC ? Colonne 3 de la listbox (et 45 du fichier excel)

Et comment aligner les sommes à droite ?

Voir image

Merci à tous

Nom : CHF.png
Affichages : 269
Taille : 37,9 Ko

Nom : CHF.png
Affichages : 269
Taille : 37,9 Ko

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
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
Option Compare Text
Dim f, BD(), choix(), Rng, Ncol, NcolInt, colVisu(), colInterro(), Decal
Private Sub BT_Modifications_ce_jour_Click()
    If Me.TextBox1.Value Like "*Maj_data_*" Then
        Me.TextBox1 = " Maj_data_" & Date
    Else
        Me.TextBox1 = Me.TextBox1 & " Maj_data_" & Date
    End If
End Sub
Private Sub BT_Modifications_hier_Click()
    If Me.TextBox1.Value Like "*Maj_data_*" Then
        Me.TextBox1 = " Maj_data_" & Date - 1
    Else
        Me.TextBox1 = Me.TextBox1 & " Maj_data_" & Date - 1
    End If
End Sub
Private Sub UserForm_Initialize()
Dim LargeurCol()
    Me.Left = Application.Left + Application.Width / 2 - Me.Width / 2 'Pour centrer sur l'application en largeur
    Me.Top = Application.Top + Application.Height / 2 - Me.Height / 2 'Pour centrer sur l'application en hauteur
    'TextBox1 est une ComboBox pour éviter de remplacer le texte
    Me.TextBox1.List = Array( _
    "A_planifier_dépannage", _
    "A_planifier_réparations", _
    "A_planifier En ville", _
    "A_planifier Zone-1", _
    "A_planifier Zone-2", _
    "A_planifier Zone-3", _
    "A_planifier Zone-4", _
    "A_planifier_livraison_1_tech.", _
    "A_planifier_livraison_2_tech.", _
    "A_planifier", _
    "Livraison", _
    "Dépannage", _
    "Devis_en_cours", _
    "En_commande", _
    "Réparations_client", _
    "Réparations_atelier", _
    "A_facturer", _
    "Terminer")
    Set f = Sheets("DATA_Interventions")
    Set Rng = f.Range("A3:AT" & f.[A65000].End(xlUp).Row) 'Dernière colonne, indiquer au minimum la colonne suivante : pour afficher F indiquer E
    Me.ListBox1.ColumnCount = 4
    colVisu = Array(1, 2, 45, 3)  'Numéros des colonnes à afficher
    LargeurCol = Array(0, 0, 50, 1700) 'largeur des colonnes, 0 pour masquer l'ID et l'adresse de la ligne Data
    Me.ListBox1.ColumnWidths = Join(LargeurCol, ";")
    colInterro = Array(3) 'Numéros des colonnes de la feuille DATA dans lesquels rechercher
    Decal = Rng.Row - 1 'Début de la base de donnée
    BD = Rng.Value
    Col = UBound(BD, 2): For i = LBound(BD) To UBound(BD): BD(i, Col) = i + Decal: Next i 'no enreg
    NcolInt = UBound(colInterro) + 1
    Ncol = UBound(colVisu) + 1 'ReDim ancien(1 To 1, 1 To Ncol)
    'Génération de choix()
    ReDim choix(1 To UBound(BD))
    Col = UBound(BD, 2)
    For i = LBound(BD) To UBound(BD)
        For Each k In colInterro
            choix(i) = choix(i) & BD(i, k) & "|"
        Next k
        choix(i) = choix(i) & BD(i, Col) & "|" 'no enreg
    Next i
        TriS choix, 1, UBound(choix)
        'Valeurs initiales dans ListBox
        Dim Tbl(): ReDim Tbl(1 To UBound(BD), 1 To Ncol + 1)
        For i = 1 To UBound(BD)
        c = 0
            For Each k In colVisu
                c = c + 1: Tbl(i, c) = BD(i, k)
            Next k
        c = c + 1: Tbl(i, c) = i + Decal
    Next i
    TriMultiCol Tbl, 1, LBound(Tbl), UBound(Tbl)
    Me.ListBox1.List = Tbl
    Me.ListBox1.ListIndex = -1
    Me.TextBox1 = " " 'Initialisation avec un espace pour déclencher le tri de la colonne 3 du USF
    'Exemple : Ci-dessous l'espace est situé entre les 2 ComboBox
    'Me.TextBox1 = USF_Intervention.ComboBox_Interv_Nom & " " & USF_Intervention.ComboBox_Interv_Prenom
    Me.TextBox1.SetFocus 'Placer le curseur dans la recherche
End Sub
Private Sub TextBox1_Change()
    If Me.TextBox1 <> "" Then
        Mots = Split(Trim(Me.TextBox1), " ")
        Tbl = choix
        For i = LBound(Mots) To UBound(Mots)
            Tbl = Filter(Tbl, Mots(i), True, vbTextCompare)
        Next i
        If UBound(Tbl) > -1 Then
            Dim b(): ReDim b(1 To UBound(Tbl) + 1, 1 To Ncol + 1)
            For i = LBound(Tbl) To UBound(Tbl)
                a = Split(Tbl(i), "|")
                j = a(NcolInt) - 1 - Decal + 1
                For k = 1 To Ncol
                    kk = colVisu(k - 1)
                    xx = UBound(BD)
                    b(i + 1, k) = BD(j, kk)
                Next k
                b(i + 1, k) = j + 1
            Next i
            Me.ListBox1.List = b
 
        Else
            Me.ListBox1.Clear
        End If
        Me.Label_Nombre_trouve.Caption = "Trouvé : " & UBound(Tbl) + 1
    Else
        UserForm_Initialize 'Ne pas initializer si textbox vide car recharge les données du nom et du prénom
    End If
    On Error Resume Next
    Me.Label_Somme_CHF = "CHF  " & format(Application.Sum(Application.index(Me.ListBox1.List, , 3)), "# ##0.00") & " TTC"
End Sub
Private Sub ListBox1_Click()
Dim Ligne_Data_ID_Intervention As Long
Dim Ligne_Data_ID_Clients_Interv As Long
Dim Ligne_Data_ID_Clients_Fact As Long
Dim ID_Intervention As String
Dim ID_Client_Interv As String
Dim ID_Client_Fact As String
Application.ScreenUpdating = False
    If Me.ListBox1.List(, 1) = "" Then
        'Ne rien faire si ID Vide
    Else
        If (MsgBox("Remplacer toutes les données de l'intervention, continuer ? ", vbYesNo + vbQuestion, "Intervention") = vbYes) Then
            Adresse = Me.ListBox1.List(, 1) 'colonne 2 ListBox1
            Set f = Sheets("DATA_Interventions")
            Adresse = Me.ListBox1.List(, 1) 'colonne 2 ListBox1
            Ligne_Data_ID_Intervention = f.Range(Adresse).Row
            'Données de l'interventions
            USF_Intervention.Label_ID_Intervention = f.Cells(Ligne_Data_ID_Intervention, 1)
            USF_Intervention.Label_Date_Commande = f.Cells(Ligne_Data_ID_Intervention, 4)
            USF_Intervention.Label_date_modif_data_interv = f.Cells(Ligne_Data_ID_Intervention, 5)
            USF_Intervention.Label_ID_Client_Interv = f.Cells(Ligne_Data_ID_Intervention, 6)
            USF_Intervention.Label_ID_Client_Fact = f.Cells(Ligne_Data_ID_Intervention, 7)
            USF_Intervention.Label_date_intervention = f.Cells(Ligne_Data_ID_Intervention, 16)
            USF_Intervention.ComboBox_Type_travail = f.Cells(Ligne_Data_ID_Intervention, 17)
            USF_Intervention.TextBox_Modele = f.Cells(Ligne_Data_ID_Intervention, 18)
            USF_Intervention.ComboBox_Type = f.Cells(Ligne_Data_ID_Intervention, 19)
            USF_Intervention.ComboBox_Marque = f.Cells(Ligne_Data_ID_Intervention, 20)
            USF_Intervention.TextBox_Num_serie = f.Cells(Ligne_Data_ID_Intervention, 21)
            USF_Intervention.TextBox_Num_fabrication = f.Cells(Ligne_Data_ID_Intervention, 22)
            USF_Intervention.TextBox_Anne_fabrication = f.Cells(Ligne_Data_ID_Intervention, 23)
            USF_Intervention.TextBox_Travaux = f.Cells(Ligne_Data_ID_Intervention, 24)
            USF_Intervention.TextBox_Rapport_depannage = f.Cells(Ligne_Data_ID_Intervention, 25)
            USF_Intervention.TextBox_Code_bat = f.Cells(Ligne_Data_ID_Intervention, 26)
            USF_Intervention.TextBox_Bon_commande = f.Cells(Ligne_Data_ID_Intervention, 27)
            USF_Intervention.Label_date_imprimer_fiche = f.Cells(Ligne_Data_ID_Intervention, 33)
            USF_Intervention.Label_date_envoyer_fiche = f.Cells(Ligne_Data_ID_Intervention, 34)
            If f.Cells(Ligne_Data_ID_Intervention, 36) = "" Then
                USF_Intervention.TextBox_Facturation_Piece = "0.00"
            Else
                USF_Intervention.TextBox_Facturation_Piece = Replace(CStr(f.Cells(Ligne_Data_ID_Intervention, 36).Value), ",", ".")
            End If
            If f.Cells(Ligne_Data_ID_Intervention, 37) = "" Then
                USF_Intervention.ComboBox_Facturation_Prise_en_charge = "0.00"
            Else
                USF_Intervention.ComboBox_Facturation_Prise_en_charge = format(Replace(CStr(f.Cells(Ligne_Data_ID_Intervention, 37).Value), ",", "."), "0.00")
            End If
            If f.Cells(Ligne_Data_ID_Intervention, 38) = "" Then
                USF_Intervention.ComboBox_Facturation_OIBT = "0.00"
            Else
                USF_Intervention.ComboBox_Facturation_OIBT = format(Replace(CStr(f.Cells(Ligne_Data_ID_Intervention, 38).Value), ",", "."), "0.00")
            End If
            If f.Cells(Ligne_Data_ID_Intervention, 39) = "" Then
                USF_Intervention.TextBox_Facturation_Minutes = "0"
            Else
                USF_Intervention.TextBox_Facturation_Minutes = format(Replace(CStr(f.Cells(Ligne_Data_ID_Intervention, 39).Value), ",", "."), "0")
            End If
            If f.Cells(Ligne_Data_ID_Intervention, 40) = "" Then
                USF_Intervention.Combobox_Facturation_Prive_Gerance_CHF = "0.00"
            Else
                USF_Intervention.Combobox_Facturation_Prive_Gerance_CHF = format(Replace(CStr(f.Cells(Ligne_Data_ID_Intervention, 40).Value), ",", "."), "0.00")
            End If
            If f.Cells(Ligne_Data_ID_Intervention, 41) = "" Then
                USF_Intervention.Label_Facturation_Prive_Gerance_MIN = "0.00"
            Else
                USF_Intervention.Label_Facturation_Prive_Gerance_MIN = format(Replace(CStr(f.Cells(Ligne_Data_ID_Intervention, 41).Value), ",", "."), "0.00")
            End If
            If f.Cells(Ligne_Data_ID_Intervention, 42) = "" Then
                USF_Intervention.Label_Facturation_Total_Main_oeuvre = "0.00"
            Else
                USF_Intervention.Label_Facturation_Total_Main_oeuvre = format(Replace(CStr(f.Cells(Ligne_Data_ID_Intervention, 42).Value), ",", "."), "0.00")
            End If
            If f.Cells(Ligne_Data_ID_Intervention, 43) = "" Then
                USF_Intervention.Label_Facturation_Total_Facture_HT = "0.00"
            Else
                USF_Intervention.Label_Facturation_Total_Facture_HT = format(Replace(CStr(f.Cells(Ligne_Data_ID_Intervention, 43).Value), ",", "."), "0.00")
            End If
            If f.Cells(Ligne_Data_ID_Intervention, 44) = "" Then
                USF_Intervention.TextBox_Facturation_TVA = "7.7"
            Else
                USF_Intervention.TextBox_Facturation_TVA = format(Replace(CStr(f.Cells(Ligne_Data_ID_Intervention, 44).Value), ",", "."), "0.0")
            End If
            If f.Cells(Ligne_Data_ID_Intervention, 45) = "" Then
                USF_Intervention.Label_Facturation_Total_Facture_TTC = "0.00"
            Else
                USF_Intervention.Label_Facturation_Total_Facture_TTC = format(Replace(CStr(f.Cells(Ligne_Data_ID_Intervention, 45).Value), ",", "."), "0.00")
            End If
            'Calculer la facturation
            USF_Intervention.BT_Calculer_facturation_Click
'Initialization adresse d'intervention depuis la DATA_Clients
            Set f = Sheets("DATA_Clients")
                ID_Client_Interv = USF_Intervention.Label_ID_Client_Interv
            If ID_Client_Interv <> "" Then
                Set PlageDeRecherche = f.Columns(1)
                Set Trouve = PlageDeRecherche.Cells.Find(what:=ID_Client_Interv, LookAt:=xlWhole)
                If Trouve Is Nothing Then
                    'ici, traitement pour le cas où la valeur n'est pas trouvée
                    MsgBox "L'id du client " & ID_Client_Interv & " n'éxiste pas dans la base de donnée.", vbExclamation, "! Oups ! Action interrompue"
                    Label_ID_Client_Interv = ""
                Else
                    'ici, traitement pour le cas où la valeur est trouvée
                    AdresseTrouvee = Trouve.Address
                    Ligne_Data_ID_Clients_Interv = f.Range(AdresseTrouvee).Row
                    USF_Intervention.Label_interv_date_modif_data_client = f.Cells(Ligne_Data_ID_Clients_Interv, 5) & " - Id client : "
                    USF_Intervention.ComboBox_Interv_Civilite = f.Cells(Ligne_Data_ID_Clients_Interv, 6)
                    USF_Intervention.ComboBox_Interv_Nom = f.Cells(Ligne_Data_ID_Clients_Interv, 7)
                    USF_Intervention.ComboBox_Interv_Prenom = f.Cells(Ligne_Data_ID_Clients_Interv, 8)
                    USF_Intervention.ComboBox_Interv_Fonction = f.Cells(Ligne_Data_ID_Clients_Interv, 9)
                    USF_Intervention.TextBox_Interv_Mobile = f.Cells(Ligne_Data_ID_Clients_Interv, 10)
                    USF_Intervention.TextBox_Interv_Bureau = f.Cells(Ligne_Data_ID_Clients_Interv, 11)
                    USF_Intervention.TextBox_Interv_Mail = f.Cells(Ligne_Data_ID_Clients_Interv, 12)
                    USF_Intervention.ComboBox_Interv_Raison_sociale = f.Cells(Ligne_Data_ID_Clients_Interv, 13)
                    USF_Intervention.ComboBox_Interv_Rue = f.Cells(Ligne_Data_ID_Clients_Interv, 14)
'                    USF_Intervention.TextBox_Interv_NPA = f.Cells(Ligne_Data_ID_Clients_Interv, 15) automatique avec  la ville
                    USF_Intervention.ComboBox_Interv_Ville = f.Cells(Ligne_Data_ID_Clients_Interv, 16)
                    USF_Intervention.ComboBox_Interv_Etage_Num = f.Cells(Ligne_Data_ID_Clients_Interv, 17)
                    USF_Intervention.ComboBox_Interv_Appart_num = f.Cells(Ligne_Data_ID_Clients_Interv, 18)
'                    USF_Intervention.ComboBox_Interv_Zone = f.Cells(Ligne_Data_ID_Clients_Interv, 19) automatique avec  la ville
                    USF_Intervention.Label_Date_Ajouter_client_Outlook = f.Cells(Ligne_Data_ID_Clients_Interv, 20)
                    If USF_Intervention.Label_Date_Ajouter_client_Outlook = "" Then
                        USF_Intervention.BT_Ajouter_client_Outlook.Caption = "Ajouter ce client dans Outlook"
                        USF_Intervention.BT_Ajouter_client_Outlook.BackColor = RGB(0, 255, 0)
                    Else
                        USF_Intervention.BT_Ajouter_client_Outlook.Caption = "Ce client est dans Outlook depuis le :"
                        USF_Intervention.BT_Ajouter_client_Outlook.BackColor = &H80000004
                    End If
                End If
            End If
'Initialization adresse de facturation depuis la DATA_Clients
            Set f = Sheets("DATA_Clients")
            ID_Client_Fact = USF_Intervention.Label_ID_Client_Fact
            If ID_Client_Fact <> "" Then
                Set PlageDeRecherche = f.Columns(1)
                Set Trouve = PlageDeRecherche.Cells.Find(what:=ID_Client_Fact, LookAt:=xlWhole)
                If Trouve Is Nothing Then
                    'ici, traitement pour le cas où la valeur n'est pas trouvée
                    MsgBox "L'id du client " & ID_Client_Fact & " n'éxiste pas dans la base de donnée.", vbExclamation, "! Oups ! Action interrompue"
                    Label_ID_Client_Fact = ""
                Else
                    'ici, traitement pour le cas où la valeur est trouvée
                    AdresseTrouvee = Trouve.Address
                    Ligne_Data_ID_Clients_Fact = f.Range(AdresseTrouvee).Row
                    USF_Intervention.Label_fact_date_modif_data_client = f.Cells(Ligne_Data_ID_Clients_Fact, 5) & " - Id client : "
                    USF_Intervention.ComboBox_Fact_Civilite = f.Cells(Ligne_Data_ID_Clients_Fact, 6)
                    USF_Intervention.ComboBox_Fact_Nom = f.Cells(Ligne_Data_ID_Clients_Fact, 7)
                    USF_Intervention.ComboBox_Fact_Prenom = f.Cells(Ligne_Data_ID_Clients_Fact, 8)
                    USF_Intervention.ComboBox_Fact_Fonction = f.Cells(Ligne_Data_ID_Clients_Fact, 9)
                    USF_Intervention.TextBox_Fact_Mobile = f.Cells(Ligne_Data_ID_Clients_Fact, 10)
                    USF_Intervention.TextBox_Fact_Bureau = f.Cells(Ligne_Data_ID_Clients_Fact, 11)
                    USF_Intervention.TextBox_Fact_Mail = f.Cells(Ligne_Data_ID_Clients_Fact, 12)
                    USF_Intervention.ComboBox_Fact_Raison_sociale = f.Cells(Ligne_Data_ID_Clients_Fact, 13)
                    USF_Intervention.ComboBox_Fact_Rue = f.Cells(Ligne_Data_ID_Clients_Fact, 14)
'                    USF_Intervention.TextBox_Fact_NPA = f.Cells(Ligne_Data_ID_Clients_Fact, 15) automatique avec  la ville
                    USF_Intervention.ComboBox_Fact_Ville = f.Cells(Ligne_Data_ID_Clients_Fact, 16)
                    USF_Intervention.ComboBox_Mauvais_Payeur = f.Cells(Ligne_Data_ID_Clients_Fact, 21)
                End If
            End If
        End If
        Unload Me
    End If 'SI ID vide
Application.ScreenUpdating = True
End Sub
Sub TriMultiCol(a, ColTri, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2, ColTri)
  g = gauc: d = droi
  Do
    Do While a(g, ColTri) < ref: g = g + 1: Loop
    Do While ref < a(d, ColTri): d = d - 1: Loop
    If g <= d Then
      For k = LBound(a, 2) To UBound(a, 2)
        temp = a(g, k): a(g, k) = a(d, k): a(d, k) = temp
      Next k
      g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call TriMultiCol(a, ColTri, g, droi)
  If gauc < d Then Call TriMultiCol(a, ColTri, gauc, d)
End Sub
Sub TriS(a, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
     Do While a(g) < ref: g = g + 1: Loop
     Do While ref < a(d): d = d - 1: Loop
     If g <= d Then
        temp = a(g): a(g) = a(d): a(d) = temp
        g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droi Then Call TriS(a, g, droi)
   If gauc < d Then Call TriS(a, gauc, d)
End Sub
Private Sub BT_Annuler_Click()
    Unload Me
End Sub

**goninph** · 24/07/2020, 13h17

Voici comment ajouter 2 décimales dans la colonne de la Listbox

Reste plus qu'à trouver une combine pour aligner les sommes à droite ...

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
Private Sub TextBox1_Change()
    If Me.TextBox1 <> "" Then
        Mots = Split(Trim(Me.TextBox1), " ")
        Tbl = choix
        For i = LBound(Mots) To UBound(Mots)
            Tbl = Filter(Tbl, Mots(i), True, vbTextCompare)
        Next i
        If UBound(Tbl) > -1 Then
            Dim b(): ReDim b(1 To UBound(Tbl) + 1, 1 To Ncol + 1)
            For i = LBound(Tbl) To UBound(Tbl)
                a = Split(Tbl(i), "|")
                j = a(NcolInt) - 1 - Decal + 1
                For k = 1 To Ncol
                    kk = colVisu(k - 1)
                    xx = UBound(BD)
                    b(i + 1, k) = BD(j, kk)
                Next k
                b(i + 1, k) = j + 1
            Next i
            Me.ListBox1.List = b
            
        Else
            Me.ListBox1.Clear
        End If
        Me.Label_Nombre_trouve.Caption = "Trouvé : " & UBound(Tbl) + 1
    Else
        UserForm_Initialize 'Ne pas initializer si textbox vide car recharge les données du nom et du prénom
    End If
    On Error Resume Next 'Pour empêcher l'erreur lorsque la listbox est vide
    Me.Label_Somme_CHF = "CHF  " & format(Application.Sum(Application.index(Me.ListBox1.List, , 3)), "# ##0.00") & " TTC"
    'Boucle pour ajouter 2 décimales et le séparateur de milliers dans la colonne de la somme CHF TTC de la listbox
    For j = 0 To ListBox1.ListCount - 1
        For i = 2 To 2 '2 pour travailler sur la 3ème colonne sachant que la première colonne est 0
            ListBox1.Column(i, j) = format(ListBox1.Column(i, j), "# ##0.00")
        Next i
    Next j
End Sub