Module de Classe - on event Click maintenu

Bonjour,

Par avance, désolé de l'explication très flou de mon problème, mais je suis vraiment dans le vague la...:calim2:

J'ai un userform1 qui, en s'initialisant instance une variable moncontrole() de classe pour chaque contrôle présent sur cet userform
Quand je clique sur un bouton1, la variable de classe a une sub lebouton_click qui lance l'userform 2

Quand l'userform2 s'ouvre, il instance une variable de classe moncontrole() pour chaque contrôle présent sur cet userform EN EFFAÇANT moncontrole() préalablement celles de l'userfom1

Jusqu'ici tout fonctionne ... je crois ....

Quand l'userfom2 se ferme, avant de se fermer, il efface moncontrole() et l’instance pour les contrôles de l'userform1 pour qu'il soit fonctionnel, il se .hide et on devrait retourner sur l'userform1 MAIS je ne sais pourquoi, le bouton1 et encore appuyé et ré-ouvre userform2....

J'ai essayé de metre des variable public pour lui dire de ne pas se relancer mais ca fonctionne aléatoirement , ce n'est pas beau du tout (j'ai déja PLEINS de variables qui bloquent les recalculs intempestifs)
je suis désolé de ne pas être très clair mais c'est surement par ce que ca ne l'est pas dans ma tete que le problème existe ....

Bonjour
essayer de remplacer.hide par unload userform ??
et nous dire le résultat

Bonjour,
comment et ou déclares tue ta variable?

Code:

1
2
3
4
5
6
7
8
Public moncontrole As Object
Private Sub UserForm_Initialize()
Set moncontrole = CreateObject("Scripting.Dictionary")
For i = 0 To Me.Controls.Count - 1
    moncontrole.Add Me.Controls(i).Name, New Classe1
    Set moncontrole(Me.Controls(i).Name).lebouton = Me.Controls(i)
Next
End Sub

BENNASR, j'ai essayé le unload me, ça ne marche pas mieux

dysorthographie, ma variable est déclaré en haut d'un module standard

Code:

Public LesControls() As TousLesControls

la variable se réinitialise ainsi .....

Le code grandement réduit :

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
Sub IntegrerTousLesControl()
 
 
Dim i As Integer
Dim ctu As MSForms.Control
Dim ControlePrevu As Boolean
CompteurFrame = 0
 
i = 0
ReDim Preserve LesControls(0 To i)
    For Each ctu In USF.Controls                             ' on boucle sur tout les control de l'userform
    ControlePrevu = False
 
            Set LesControls(i) = New TousLesControls
            Select Case TypeName(ctu)
                 Case Is = "TextBox"                             ' si c'est un text box
                     Set LesControls(i).LEControleClasseTXT = ctu ' on le range au bon endroit dans la variable de classe
                     LesControls(i).LeType = "TextBox"           ' on note son genre
                     ControlePrevu = True                        ' on indique qu'on en a trouvé un !
                     'si le controle devant lequel on passe est prévu ( textbox ou combobox ou label ...)
            end select          
            If ControlePrevu = True Then         
                LesControls(i).lenom = ctu.Name     'on met son nom en variable lenom de la variable de classe               
                i = i + 1
                ReDim Preserve LesControls(0 To i)
            End If
    Next ctu
 
End Sub

J'imagine qu'on peut faire bien mieux que ça, soyez indulgent ...

elle est dans un module standard donc si tu la modifies à chaque ouverture de formulaire tu l'écrases!

dans mon exemple elle est dans le formulaire lui même don tu ne peux pas 'ucraser et comme elle est public dans mon UserForm tu y accède comme ça!

Code:

debug.print UserForm1.LesControls(0)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Public WithEvents lebouton As MSForms.CommandButton
Public WithEvents leTextBox As MSForms.TextBox
Public Property Let LeControl(value As Object)
Select Case TypeName(value)
    Case "TextBox": Set leTextBox = value
    Case "CommandButton": Set lebouton = value
End Select
End Property
 
Private Sub lebouton_Click()
End Sub
 
Private Sub leTextBox_Change()
End Sub

le redim tu oublis!

Code:

1
2
3
4
5
6
7
8
Public moncontrole As Object
Private Sub UserForm_Initialize()
Set moncontrole = CreateObject("Scripting.Dictionary")
For i = 0 To Me.Controls.Count - 1
    moncontrole.Add Me.Controls(i).Name, New TousLesControls
     moncontrole(Me.Controls(i).Name).LeControl = Me.Controls(i)
Next
End Sub

LE souci c'est que je fais avoir plein de userform différent et je voulait faire ça dans un module normal.
J'ai bien pensé a déclarr une variable par userform mais si je les déclare dans l'USF je ne peux pas les passer byref a mon module normal, j'ai aussi pensé à les passer byval puis les copier ensuite mais ca me parrait pas la bonne idée

De plus j'ai plein de calcul qui s'effctuent sur cette variable (le code fait 2500 lignes pour l'instant)

Donc bon je pourrait tout refaire mais j'aimerait surtout que ce bouton se "déclique" tous seul :aie:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Public Usfs As New Collection, i As Long
Sub test()
Dim Frm As New UserForm1
Dim Frm2 As New UserForm1
i = i + 1
Usfs.Add New Usf, Frm.Name & i
Set Usfs(Frm.Name & i).Usf = Frm
Usfs(Frm.Name & i).ScanControl
Frm.Show fase
i = i + 1
Usfs.Add New Usf, Frm2.Name & i
Set Usfs(Frm.Name & i).Usf = Frm2
Usfs(Frm.Name & i).ScanControl
Frm2.Show False
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Public WithEvents Usf As MSForms.UserForm
Public moncontrole As Object
Public Sub ScanControl()
For i = 0 To Usf.Controls.Count - 1
    moncontrole.Add Usf.Controls(i).Name, New TousLesControls
     moncontrole(Usf.Controls(i).Name).LeControl = Usf.Controls(i)
Next
End Sub
 
Private Sub Class_Initialize()
Set moncontrole = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
Set moncontrole = Nothing
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Public WithEvents lebouton As MSForms.CommandButton
Public WithEvents leTextBox As MSForms.TextBox
Public Property Let LeControl(value As Object)
Select Case TypeName(value)
    Case "TextBox": Set leTextBox = value
    Case "CommandButton": Set lebouton = value
End Select
End Property
 
Private Sub lebouton_Click()
    MsgBox "ff"
End Sub
 
Private Sub leTextBox_Change()
End Sub

Merci de tes réponse dysorthographie.

Je ne suis hélas pas assez doué pour appliquer tes solutions.

Je ne sait pas utiliser les collections (je comprend pas comment les utiliser simplement vu que l'on ne peux pas modifier un object a l'interieur)
je ne sais pas comment utiliser CreateObject("Scripting.Dictionary")

de plus j'ai un doute quand à l'adaptabilité de mon code au tient ...

Pour info je te met un plus gros bout de mon code mais je me rend bien compte qu'il est trop long à lire tel quel ...

Module de classe TousLesControles

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
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
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
'on déclare une variable de notre classe dans laquelle on va placer le controle
Option Explicit
Public WithEvents LEControleClasseTXT As MSForms.TextBox
Public WithEvents LEControleClasseLBL As MSForms.Label
Public WithEvents LEControleClasseCMB As MSForms.CommandButton
Public WithEvents LEControleClasseCBB As MSForms.ComboBox
Public WithEvents LEControleClasseCB As MSForms.CheckBox
Public WithEvents LEControleClasseFR As MSForms.Frame
Public lenom As String, LeType As String, LeTag As String, LeFrame As String, LaVarEnString As String, LIndice As Currency
Dim InfosTag As Variant         'Dans cette variable nous allons stocker les infos qui sont dans le tag
 
 
 
 
Private Sub LEControleClasseTXT_Change()   'cette fonction se déclenche si la valeur du controle est "changé"
IfChange
End Sub
Private Sub LEControleClasseLBL_Change()   'cette fonction se déclenche si la valeur du controle est "changé"
IfChange
End Sub
Private Sub LEControleClasseCMB_Click()   'cette fonction se déclenche si la valeur du controle est "changé"
If PasDeDblClick = False Then IfChange
PasDeDblClick = Not PasDeDblClick
End Sub
Private Sub LEControleClasseCBB_Change()   'cette fonction se déclenche si la valeur du controle est "changé"
IfChange
End Sub
Private Sub LEControleClasseCB_Change()   'cette fonction se déclenche si la valeur du controle est "changé"
IfChange
End Sub
 
Sub IfChange()
 
    'Call ShowMeTheTag
 
If LeTag <> "" Then
 
    InfosTag = Split(LeTag, ",") 'on découpe les info du tag pour les mettre dans un tableau
    Call checkLePremierTag
 
 
        'Si l'avant dernier tag est STT on lance le recacul de total de l'usf
        '??? ineficasse et inutilte ?????
        'If infosTag(UBound(infosTag) - 1) = "STT" Then
        '    Call CalculTotalUSF
        'End If
End If
 
End Sub
Sub RemplirLesChampsViaCmb()
 
'cette variable donne l'"index" du cmb, on sait que le choix1 correspond a telle ligne dans tel onglet
Dim var() As String
var = Split(LaVarEnString, "/")
 
'ListI corespond au n° de choix dans la séléction du CMB
Dim ListI As Integer
ListI = USF.Controls(lenom).ListIndex
 
' cette variable nous permet de remetre à zéro les champ si la cmb revient sur le premier choix
Dim MiseAZero As Boolean
MiseAZero = False
If ListI = 0 Then MiseAZero = True
 
 
 
 
Dim J As Integer, i As Integer
 
calculEnCour = True 'empeche le recalcul durant le remplissage
 
For J = 2 To UBound(InfosTag)                   'pour chaque marque dans le tag du cmb ( a partir de la 3eme)
    For i = 0 To UBound(LesControls) - 1        'on le cherche dans chaque controls
        'si le controle est dans la bonne frame et qu'il a un tag
        If LesControls(i).LeFrame = LeFrame And LesControls(i).LeTag <> "" Then
            'si le tag possede une virgule
            If InStr(LesControls(i).LeTag, ",") Then
                Dim TagCTRL() As String                     'Le tag du controle qui est lu
                TagCTRL = Split(LesControls(i).LeTag, ",")  'MAintenant il est découpé
                Dim TagMaster() As String                   'Le tag qui dirige ce qu'on doit faire
                TagMaster = Split(InfosTag(J), "-")         'MAintenant il est découpé
 
                Select Case MiseAZero
                    Case Is = True      'si c'est une remise à zéro
                        If TagCTRL(UBound(TagCTRL) - 1) = "Z" And TagCTRL(UBound(TagCTRL)) = TagMaster(1) Then
                            If LesControls(i).LeType = "TextBox" Then
                                LesControls(i).LEControleClasseTXT.Value = "0"
                            Else
                                LesControls(i).LEControleClasseLBL.Caption = "0"
                            End If
                        End If
                    Case Is = False     'si l'utilisateur à fait un choix
 
                        If TagCTRL(0) = TagMaster(0) And TagCTRL(1) = TagMaster(1) Then
 
                            If LesControls(i).LeType = "TextBox" Then
                                  LesControls(i).LEControleClasseTXT.Value = Worksheets(var(0)).Cells(var(ListI), val(TagMaster(2))).Value
                            Else
                                LesControls(i).LEControleClasseLBL.Caption = Worksheets(var(0)).Cells(var(ListI), val(TagMaster(2))).Value
                            End If
 
                        End If
                End Select
 
            End If
        End If
    Next i
 
Next J
calculEnCour = False
'If MiseAZero = False Then
Call CalculFrame(LeFrame, "")
 
End Sub
 
 
Sub AfficherCacherFrame()
 
Dim i As Integer, a As Variant, b As String
 
For i = 0 To UBound(LesControls) - 1
 
    If LesControls(i).LeFrame = LeFrame And Left(LesControls(i).LeTag, 1) = "F" Then
        a = Split(LesControls(i).LeTag, ",")
        If UBound(a) > 0 Then
            If a(1) = InfosTag(1) Then
               USF.Controls(LesControls(i).lenom).Visible = LEControleClasseCB.Value
            End If
        End If
    End If
Next i
 
End Sub
Sub ShowMeTheTag()
Dim tex As String
 
tex = "le control : " & lenom & " - type :" & LeType
If LeTag <> "" Then tex = tex & " - Tag : " & LeTag
If LeFrame <> "" Then tex = tex & " - frame : " & LeFrame
Debug.Print (tex)
 
End Sub
Sub MinuteChange(Optional Mnsoit As Boolean = True)
Dim i As Integer, a As Variant, b As String
 
For i = 0 To UBound(LesControls) - 1
 
    If LesControls(i).LeFrame = LeFrame And Left(LesControls(i).LeTag, 1) = "H" Then
        a = Split(LesControls(i).LeTag, ",")
        If UBound(a) > 0 Then
            If a(1) = InfosTag(1) Then
                If IsNumeric(LEControleClasseTXT.Value) = True And LEControleClasseTXT.Value < 1000000 Then
 
                    LesControls(i).LEControleClasseLBL.Caption = "mn soit " & Heure(LEControleClasseTXT.Value)
                    If Mnsoit = False Then
                        b = LesControls(i).LEControleClasseLBL.Caption
                        b = Right(b, Len(b) - 8)
                        LesControls(i).LEControleClasseLBL.Caption = b
                    End If
                    Else
                    LEControleClasseTXT.Value = 0
                End If
            End If
        End If
    End If
Next i
End Sub
Sub TotalMinutes()
Dim i As Integer, total As Double, TotalPresent As Boolean, LeTotal As Integer
TotalPresent = False
 
    For i = 0 To UBound(LesControls) - 1
        If LesControls(i).LeFrame = LeFrame Then
            If Left(LesControls(i).LeTag, 2) = "TM" Then
                TotalPresent = True
                LeTotal = i
            End If
        End If
    Next i
 
If TotalPresent = False Then Exit Sub
 
    For i = 0 To UBound(LesControls) - 1
        If LesControls(i).LeFrame = LeFrame Then
            If Left(LesControls(i).LeTag, 1) = "M" Then
                If LesControls(i).LEControleClasseTXT.Value <> "" Then
                    total = total + LesControls(i).LEControleClasseTXT.Value
                End If
            End If
        End If
    Next i
 
    If IsNull(total) = False Then LesControls(LeTotal).LEControleClasseTXT.Value = total
 
 
End Sub
Sub checkLePremierTag()
 
    Select Case InfosTag(0)  ' on verifi ce que lon doit faire en fonction de la preiere partie du tag
        Case Is = "opt"       ' si le tag commence par opt
            Call Porte1.OptionPrecalcul
        Case Is = "M"       ' si le tag commence par m
            Call MinuteChange(False)
            If calculEnCour = False Then
                Call CalculFrame(LeFrame, lenom)
                Call RemplirLaVariableFrame
            End If
        Case Is = "MS"      ' si le tag commence par mS
            Call MinuteChange
            If calculEnCour = False Then
                Call CalculFrame(LeFrame, lenom)
                Call RemplirLaVariableFrame
            End If
        Case Is = "I", "X", "+", "R", "RE", "IE", "MO", "MQ"           ' si le tag commence par I ou R ou X ou
            If calculEnCour = False Then
                Call CalculFrame(LeFrame, lenom)
                Call RemplirLaVariableFrame
            End If
        Case Is = "CF"       ' si le tag commence par CF
            Call AfficherCacherFrame
        Case Is = "CMB"       ' si le tag commence par CF
            If Len(LaVarEnString) <> 0 Then Call RemplirLesChampsViaCmb
        Case Is = "FINITIONS"
            Call LancerLesFinitions
        Case Is = "testshow"            ' pour un test, a supprimer
            Call LancerTestShow
 
    End Select
 
End Sub
Sub LancerTestShow()
 
 
UserForm2.Show
db ("ok")
End Sub
Sub LancerLesFinitions()
 
FrameEnCourDeFinition = QuelFrame(LeFrame)
Finition.Show
 
End Sub
 
 
Sub RemplirLaVariableFrame()
'dans cette sub on se s'interesse au'a ce qui suis @ dans le tag
'ca v nous permetre d'affecter la valeur a la variable
Dim Tag As String, Fr As Integer, J As Integer, i As Integer
 
'***NE SERT A RIEN***
'on recupere le mot clef voulu juste après le @ et la virgule dans le tag
'Tag = (Split((Split(LeTag, "@")(1)), ",")(1))
 
'on trouve le numéro de la variable MesFrames a qui ce controle appartient et on le met en J
For i = 1 To UBound(MesFrames)
    If LeFrame = MesFrames(i).Name Then
        J = i
        Exit For
    End If
Next i
 
 
 
With MesFrames(J)
    With .MethodeEtMatiere
'        .MethodeFeuille = ValeurCTRLSelonTag("MEFL")
'        .MethodeLigne = ValeurCTRLSelonTag("MELG")
'        .MethodeCode = ValeurCTRLSelonTag("MECD")
'        .Longueur = ValeurCTRLSelonTag("MELO")
'        .Largeur = ValeurCTRLSelonTag("MELA")
'        .Epaisseur = ValeurCTRLSelonTag("MEEP")
'        .m3Matiere = ValeurCTRLSelonTag("ME3M")
'        .m3Placage = ValeurCTRLSelonTag("ME3P")
'        .m3Finitions = ValeurCTRLSelonTag("ME3P")
'
'        .MatiereFeuille = ValeurCTRLSelonTag("MAFL")
'        .MatiereLigne = ValeurCTRLSelonTag("MALG")
'        .MatiereCode = ValeurCTRLSelonTag("MACD")
'        .MatiereIndexCout = ValeurCTRLSelonTag("MAIC")
'        .MatiereCout = ValeurCTRLSelonTag("MACE")
'
'        .TempsDeFab = ValeurCTRLSelonTag("METF")
'        .TempsDePose = ValeurCTRLSelonTag("MATP")
    End With
    With .Placage
'        .PlacageFeuille = ValeurCTRLSelonTag("PLFL")
'        .PlacageLigne = ValeurCTRLSelonTag("PLLG")
'        .PlacageCode = ValeurCTRLSelonTag("PLCD")
'
'        .PlacageIndexCout = ValeurCTRLSelonTag("PLIC")
'        .PlacageCout = ValeurCTRLSelonTag("PLTT")
'
'        .TempsDePlacage = ValeurCTRLSelonTag("PLMN")
 
    End With
    With .Finitions
        With .FinitionsLaque
'            .NomDeLaFeuille = ValeurCTRLSelonTag("LAFL")
'            .Ligne = ValeurCTRLSelonTag("LALG")
'            .ItemChoisi = ValeurCTRLSelonTag("LAIC")
'            .coutMatiere = ValeurCTRLSelonTag("LACM")
'            .MainsDoeuvre = ValeurCTRLSelonTag("LAMO")
'            .TotalMOminutes = ValeurCTRLSelonTag("LAMN")
'            .TotalMO€ = ValeurCTRLSelonTag("LAME")
'            .TotalMat = ValeurCTRLSelonTag("LATM")
'            .Total€ = ValeurCTRLSelonTag("LATT")
'            .NbDePasse = ValeurCTRLSelonTag("LANB")
'            .Bicouche = ValeurCTRLSelonTag("LABC")
        End With
        With .FinitionsSupport
'            .NomDeLaFeuille = ValeurCTRLSelonTag("SUFL")
'            .Ligne = ValeurCTRLSelonTag("SULG")
'            .ItemChoisi = ValeurCTRLSelonTag("SUIC")
'            .CoutSousTraitant = ValeurCTRLSelonTag("SUST")
'            .MainsDoeuvre = ValeurCTRLSelonTag("SUMO")
'            .TotalMOminutes = ValeurCTRLSelonTag("SUMN")
'            .TotalMO€ = ValeurCTRLSelonTag("SUME")
'            .TotalMat = ValeurCTRLSelonTag("SUTM")
'            .Total€ = ValeurCTRLSelonTag("SUTT")
        End With
        With .FinitionsTeintePatine
'            .NomDeLaFeuille = ValeurCTRLSelonTag("TPFL")
'            .Ligne = ValeurCTRLSelonTag("TPLG")
'            .ItemChoisi = ValeurCTRLSelonTag("TPIC")
'            .coutMatiere = ValeurCTRLSelonTag("TPCM")
'            .MainsDoeuvre = ValeurCTRLSelonTag("TPMO")
'            .TotalMOminutes = ValeurCTRLSelonTag("TPMN")
'            .TotalMO€ = ValeurCTRLSelonTag("TPME")
'            .TotalMat = ValeurCTRLSelonTag("TPTM")
'            .Total€ = ValeurCTRLSelonTag("TPTT")
        End With
        With .FinitionsVernis
'            .NomDeLaFeuille = ValeurCTRLSelonTag("VRFL")
'            .Ligne = ValeurCTRLSelonTag("VRLG")
'            .ItemChoisi = ValeurCTRLSelonTag("VRIC")
'            .coutMatiere = ValeurCTRLSelonTag("VRCM")
'            .MainsDoeuvre = ValeurCTRLSelonTag("VRMO")
'            .TotalMOminutes = ValeurCTRLSelonTag("VRMN")
'            .TotalMO€ = ValeurCTRLSelonTag("VRME")
'            .TotalMat = ValeurCTRLSelonTag("VRTM")
'            .Total€ = ValeurCTRLSelonTag("VRTT")
'            .NbDePasse = ValeurCTRLSelonTag("VRNB")
'            .Bicouche = ValeurCTRLSelonTag("VRBC")
        End With
 
'        .TotalMOminutes = ValeurCTRLSelonTag("FIMN")
'        .TotalMO€ = ValeurCTRLSelonTag("FIME")
'        .TotalMat = ValeurCTRLSelonTag("FITM")
'        .Total€ = ValeurCTRLSelonTag("FITT")
'        .Finitions = ValeurCTRLSelonTag("FIBO")
'        .IdAppelant = ValeurCTRLSelonTag("FIID")
'        .FrameAppelant = ValeurCTRLSelonTag("FIFR")
'        .indice = ValeurCTRLSelonTag("FIID")
 
 
    End With
 
'    .Name = ValeurCTRLSelonTag("
'    .mCaption = ValeurCTRLSelonTag("
'    .mTag = ValeurCTRLSelonTag("
'    .mTexte = ValeurCTRLSelonTag("
 
End With
 
 
 
End Select
End Sub
 
Function ValeurCTRLSelonTag(Arobase As String)
' cette fonction retourne la valeur d'un controle selon son t@g dans le frame de l'appelant
Dim i As String, TagLu As String
For i = 0 To UBound(LesControls)                                    'on boucle sur tous les controls
    If LesControls(i).LeFrame = LeFrame Then                        'on verifi si le ctrl est dans la bonne frame
        TagLu = (Split((Split(LesControls(i).LeTag, "@")(1)), ",")(1))  'on récupere le t@g du ctrl lu
        If LarobaseEnLecture = Arobase Then                         'on regarde si le t@g corespond avec celui recherché
            Select Case LesControls(i).LeType
                Case Is = "Label"
                    ValeurCTRLSelonTag = LesControls(i).LEControleClasseLBL.Caption
                Case Is = "TextBox"
                    ValeurCTRLSelonTag = LesControls(i).LEControleClasseTXT.Value
            End Select
            Exit Function
        End If
 
    End If
Next i
End Function

module normal

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
Public LesControls() As TousLesControls
Public MesFrames() As LesFrames, CompteurFrame As Integer
 
Sub ClasseMoiCa(Optional PasLesFrames As Boolean = False)
If PasLesFrames = False Then Call FrameDansLesTag        'on ajoute le nom du frame dans le tag de chaque control
Call IntegrerTousLesControl 'on met tous les controle de l'usf en classe (et on retire le nom des frame)
End Sub
Sub IntegrerTextbox()
 
 
Dim i As Integer
Dim ctu As MSForms.Control
 
 
i = 0
    For Each ctu In Porte1.Controls
    If ctu.Tag <> "" Then
            Set LeCalculeur(i) = New BoxAcalculer
            Set LeCalculeur(i).LaTextbox = ctu
            i = i + 1
        End If
    Next ctu
'Porte1.Show 0
End Sub
 
 
Sub IntegrerTousLesControl()
 
' /!\/!\ dedim preserve tous ca tout ca /!\/!\
Dim i As Integer, UnTag As Variant
Dim ctu As MSForms.Control
Dim ControlePrevu As Boolean
CompteurFrame = 0
 
i = 0
ReDim Preserve LesControls(0 To i)
    For Each ctu In USF.Controls                             ' on boucle sur tout les control de l'userform
    ControlePrevu = False
 
            Set LesControls(i) = New TousLesControls
            Select Case TypeName(ctu)
            Case Is = "TextBox"                             ' si c'est un text box
                Set LesControls(i).LEControleClasseTXT = ctu ' on le range au bon endroit dans la variable de classe
                LesControls(i).LeType = "TextBox"           ' on note son genre
                ControlePrevu = True                        ' on indique qu'on en a trouvé un !
            Case Is = "Label"
                Set LesControls(i).LEControleClasseLBL = ctu
                LesControls(i).LeType = "Label"
                ControlePrevu = True
            Case Is = "CommandButton"
                Set LesControls(i).LEControleClasseCMB = ctu
                LesControls(i).LeType = "CommandButton"
                ControlePrevu = True
            Case Is = "ComboBox"
                Set LesControls(i).LEControleClasseCBB = ctu
                LesControls(i).LeType = "ComboBox"
                ControlePrevu = True
            Case Is = "CheckBox"
                Set LesControls(i).LEControleClasseCB = ctu
                LesControls(i).LeType = "CheckBox"
                ControlePrevu = True
            Case Is = "Frame"
                Set LesControls(i).LEControleClasseFR = ctu
                LesControls(i).LeType = "Frame"
                ControlePrevu = True
                If Left(ctu.Tag, 1) = "F" Then Call ClasseDeFrame(ctu)
            End Select
 
            'si le controle devant lequel on passe est prévu ( textbox ou combobox ou label ...)
            If ControlePrevu = True Then
 
                LesControls(i).lenom = ctu.Name     'on met son nom en variable lenom de la variable de classe
 
                UnTag = Split(ctu.Tag, "£")         'on cherche la frame parente dans le tag
                Select Case UBound(UnTag)
 
                Case Is = 0
                    If InStr(ctu.Tag, "£") <> 0 Then
                        LesControls(i).LeFrame = UnTag(0)   'si il ni a que ca dans le tag on le met dans LeFrame
                    Else
                        LesControls(i).LeTag = UnTag(0)   'si il ni a que ca dans le tag on le met dans LeFrame
                    End If
                Case Is = 1
                    LesControls(i).LeTag = UnTag(0)     ' si il y avait un autre tag on le garde dans LeTag
                    LesControls(i).LeFrame = UnTag(1)
                End Select
 
                i = i + 1
                ReDim Preserve LesControls(0 To i)
            End If
    Next ctu
 
End Sub
 
Sub FrameDansLesTag()
Dim J As Integer
Dim i As Integer, a As MSForms.Control, b As MSForms.Control
'On commence par boucler sur tous les controle à la recherche des frames
'puis dans chasue frame on rajoute au tag de tout les controle le signe £ et le nom de la frame
 
    For Each a In USF.Controls
        If TypeName(a) = "Frame" Then
            For Each b In USF.Controls(a.Name).Controls
            b.Tag = b.Tag & "£" & a.Name
            Next b
        End If
    Next a
End Sub
 
Sub ClasseDeFrame(ctu As MSForms.Control) 'fonction généralement appelée par "ClasseMoiCa"
 
CompteurFrame = CompteurFrame + 1
ReDim Preserve MesFrames(0 To CompteurFrame)
Set MesFrames(CompteurFrame) = New LesFrames
        With MesFrames(CompteurFrame)
            .Caption = ctu.Caption
            .Tag = ctu.Tag
            .Name = ctu.Name
        End With
LaPorte(LitemSelectione).ListeDesFrames = _
LaPorte(LitemSelectione).ListeDesFrames & "@" & CompteurFrame & "*" & ctu.Name
 
 
 
 
End Sub

userform :

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
Private Sub CommandButton10_Click()
db (TextBox5.Tag)
End Sub
 
Private Sub CommandButton8_Click()
Call UserForm_Terminate
End Sub
 
Private Sub CommandButton9_Click()
End
End Sub
 
 
' instruction :
' Mettre CF,x dans te tag la check box d'aparition d'un frame
' Mettre F,x dans le tag de la dite frame (avec le meme x)
'
' Mettre MS,x dans les tag de case qui recoivent des minutes dont on veux dire "soit x heure"
' Mettre M,x dans les tag de case qui recoivent des minutes
' Mettre H,x dans les tag des label qui indiquent la valeur en heure (avec le meme x)
'
Private Sub UserForm_Initialize()
Set USF = Me
Set USFParent = Me
Call declA
If Modedebug > 0 Then
    Call DebugAffichageNumeroDesControles
    Exit Sub
End If
Call ClasseMoiCa
Call InitializePreCadre2
 
End Sub
 
Private Sub InitializePreCadre2() 'PRECADRE
'cette fonction s'execute quand elle est appelée par la fonction UserForm_Initialize()qui se lance au demarage automatiquement
 
'on implémentate le comboliste de paumelles
Call RemplirUneListe(MEN, "PRE", "combobox1", "Gendre de Pré-Cadre")
'on fait pareil pour les serrure
Call RemplirUneListe(MAT, "BOI", "combobox2", "Matière Utilisée", True, 3)
'on fait pareil pour les serrure
Call RemplirUneListe(MAT, "PLA", "combobox3", "Essence de placage", , 3)
 
'on lance une verif de la validité de l'encart (rouge ou vert)
'VerifOption
 
End Sub
 
 
 
Private Sub UserForm_Terminate()
Me.Hide
GestionDevis.Show
End Sub

et un autre module de calcul :

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
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
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
Dim LeFrame As String, calculS() As Variant
Dim i As Integer, Lorigine As String, QuelCalcul() As Integer
Public calculEnCour As Boolean
Dim ListeDesCalculAEffectuer() As Variant, ListeDesControlesAControler() As Variant
Dim compteurRecursif As Integer
 
 
Sub CalculFrame(ByVal LeFrame As String, Lorigine As String)
 
' on declare que l'on est en train de calculer pour eviter au calcul de créer un sur calcul
calculEnCour = True
 
' on creer le tableau des calcul de la frame
Call VariableCalcul(LeFrame)
 
'si l'origine du recalcul vien d'un controle qui est un résultat, on decide des calculs nécéssiare
If Lorigine <> "" Then
    ReDim ListeDesControlesAControler(1)
    ListeDesControlesAControler(0) = "Leure"
    ListeDesControlesAControler(1) = Lorigine
    ReDim ListeDesCalculAEffectuer(0)
    ListeDesCalculAEffectuer(0) = "Leure"
    Call ChoisirLesCalculs
    Call mettreDansLordre(ListeDesCalculAEffectuer)
    db ("Compteur récursif : " & compteurRecursif)
    compteurRecursif = 0
 
    'débugage
    Call afficher2Dimentions(CAL, calculS)
    Call Debugage(CAL, ListeDesCalculAEffectuer, 8, Lorigine)
 
 
End If
 
'on effectue les calcul néccéssaire
Call ExecuterCalcul(Lorigine)
 
' on déclare que le calcul est finit et que si une case change on peux de nouvrau recacluler
calculEnCour = False
 
'on vide la tableau de calcul
ReDim calculS(30, 3)
Call CalculTotalUSF
 
 
End Sub
Sub Debugage(CAL As Worksheet, var As Variant, colone, a As String)
Dim i As Integer
For i = 1 To UBound(var) + 1
If Not IsEmpty(var(i - 1)) Then Cells(i + 1, colone) = var(i - 1)
 
Next i
Cells(i + 1, colone) = "-Fin-"
Cells(i + 2, colone) = " "
Cells(2, colone).Value = a
End Sub
Sub mettreDansLordre(ByRef val() As Variant)
Dim i As Integer, Ok As Boolean, a As Variant
 
If UBound(val) >= 1 Then
    Do
        Ok = True
        For i = 1 To UBound(val) - 1
            If val(i) > val(i + 1) Then
                a = val(i + 1)
                val(i + 1) = val(i)
                val(i) = a
                Ok = False
            End If
        Next i
    Loop While Ok = False
    val(0) = val(1)
End If
End Sub
 
 
 
Sub ChoisirLesCalculs()
Dim J As Integer, k As Integer
 
'Compteur de récusrsivité avec sortie de secours
compteurRecursif = compteurRecursif + 1
If compteurRecursif > 1000 Then
    db ("ERREUR RECURSIVE !!!")
    Exit Sub
End If
 
Call enleverUneVariable(ListeDesControlesAControler) ' on retire la premiere variable
If ListeDesControlesAControler(0) = "" Then Exit Sub    'si plus rien a rechercher on sort
 
 
For J = 1 To UBound(calculS, 1)
    For k = 2 To UBound(calculS, 2)
        If SansE(calculS(J, k)) = ListeDesControlesAControler(0) Then
            If CheckPasDeDoublon(ListeDesControlesAControler, SansE(calculS(J, 1))) = True Then
                Call RedimEtAjoute(ListeDesControlesAControler, SansE(calculS(J, 1)))
            End If
            If CheckPasDeDoublon(ListeDesCalculAEffectuer(), J) = True Then
                Call RedimEtAjoute(ListeDesCalculAEffectuer, J)
            End If
 
        End If
    Next k
Next J
 
'appel de récursivité
Call ChoisirLesCalculs
 
End Sub
Sub RedimEtAjoute(MonTableau(), MaValeur As Variant)
ReDim Preserve MonTableau(UBound(MonTableau) + 1)
MonTableau(UBound(MonTableau)) = MaValeur
End Sub
Function CheckPasDeDoublon(MonTableau(), MaValeur As Variant)
' cette fonction revoie VRAI si la veleur ne se trouve pas encore dans le tableau
Dim w As Integer
    For w = 0 To UBound(MonTableau)         'on boucle sur toute les valeur du tableau
        If MonTableau(w) = MaValeur Then    'si une des valeur du tableau et = à la valeur à vérifier
            CheckPasDeDoublon = False           'la fonction renvois FAUX
            Exit Function                       'Et s'arrete
        End If
    Next w
CheckPasDeDoublon = True                    'si a la fin on n'a pas trouvé de valeur corespondante on met VRAI en réponse
 
End Function
 
 
Sub enleverUneVariable(var As Variant)
Dim L As Integer
var(0) = ""
If UBound(var) = 0 Then Exit Sub
 
For L = 1 To UBound(var)
    var(L - 1) = var(L)
Next L
 
ReDim Preserve var(L - 2)
End Sub
 
 
Sub VariableCalcul(LeFrame As String) 'On créée une variable qui est un tableau de calcul
 
Dim J As Integer, LeTag() As String, LenTag As Integer
 
ReDim Preserve calculS(30, 3)   'La fameuse variable qui liste les calcul de la frame
 
For i = 0 To UBound(LesControls) - 1    'on boucle sur touts les controle de l'USF
 
    'on vérifie que les controle sont dans le bon Frame ET qu'il o une virgule dans le tag
    If LesControls(i).LeFrame = LeFrame And InStr(LesControls(i).LeTag, ",") > 0 Then
        LeTag = Split(LesControls(i).LeTag, ",")    'création de varible du tag
        LenTag = UBound(LeTag)                      'combien de paire d'info dans le tag
        J = 0
        'si le controle n'est ni un frame ni une combobox alors
        If InStr(LeTag(0), "CMB") = 0 And InStr(LeTag(1), "FR") = 0 Then
            Do While LenTag + 1 >= 2 + J    'on gere les infos du tag par paires
                If LeTag(0 + J) <> "@" Then
                    Call GererLaPaireDeTag(LeTag(0 + J), LeTag(1 + J), LesControls(i).lenom)
 
                End If
                J = J + 2
            Loop
        End If
    End If
Next i
End Sub
Sub GererLaPaireDeTag(ABC As String, ByVal UN As Integer, LeControl As String)
Dim J As Integer
 
 
J = 1
Select Case ABC
    Case Is = "X", "+", "MO", "MQ" ', "M", "MS"
        calculS(UN, 0) = ABC
        Do
            J = J + 1
 
            If UBound(calculS, 2) < J Then ReDim Preserve calculS(30, J)
 
            If calculS(UN, J) = "" Then
                calculS(UN, J) = LeControl
                done = True
            End If
 
        Loop While done = False
 
    Case Is = "RE"
        calculS(UN, 1) = LeControl & "€"
    Case Is = "R"
        calculS(UN, 1) = LeControl
End Select
 
 
 
End Sub
 
Sub afficher2Dimentions(laWSheet As Worksheet, var() As Variant)
 
Dim i As Integer, J As Integer
 
For i = 0 To UBound(var, 1)
    For J = 0 To UBound(var, 2)
        If IsEmpty(var(i, J)) Then
            laWSheet.Cells(i + 2, J + 2) = "vide"
        Else
            laWSheet.Cells(i + 2, J + 2) = var(i, J)
        End If
    Next J
Next i
End Sub
Sub ExecuterCalcul(Lorigine)
 
 
 
 
 
Dim J As Integer, k As Integer, M As Integer, N As Integer, result As Currency, Haha As Integer, resultFinal As String
 
If Lorigine <> "" Then
    M = UBound(ListeDesCalculAEffectuer)
Else
    M = UBound(calculS, 1)
End If
 
 
For J = 1 To M
    N = J
    If Lorigine <> "" Then N = ListeDesCalculAEffectuer(J)
 
 
 
        Select Case calculS(N, 0)
            Case Is = "+"
                result = 0
                For k = 2 To UBound(calculS, 2)
                    If calculS(N, k) <> "" Then
                        If IsNumeric(SansE(USF.Controls(calculS(N, k)))) Then
                            result = result + SansE(USF.Controls(calculS(N, k)))
                        End If
                    End If
                Next k
            Case Is = "X"
                result = 1
                For k = 2 To UBound(calculS, 2)
                    If calculS(N, k) <> "" Then
                        If IsNumeric(SansE(USF.Controls(calculS(N, k)))) Then
                            result = result * SansE(USF.Controls(calculS(N, k)))
                        End If
                    End If
                Next k
            Case Is = "MO"
                result = 0
                For k = 2 To UBound(calculS, 2)
                    If calculS(N, k) <> "" Then
                        If IsNumeric(SansE(USF.Controls(calculS(N, k)))) Then
                            result = result + SansE(USF.Controls(calculS(N, k)))
                        End If
                    End If
                Next k
                If IsNumeric(result) Then result = result / 60 * BAR.Cells(5, 3)
            Case Is = "MQ"  'Fonction D'adition
                result = 0
                For k = 2 To UBound(calculS, 2)
                    If calculS(N, k) <> "" Then
                        If IsNumeric(SansE(USF.Controls(calculS(N, k)))) Then
                            result = result + SansE(USF.Controls(calculS(N, k)))
                        End If
                    End If
 
 
                Next k      'Arrondi au quart d'heure suppérieur
                If IsNumeric(result) Then
                    If Int(result / 15) <> result / 15 Then
                        If ((result / 15) - (Int(result / 15))) < 0.27 Then
                            result = (Int(result / 15)) * 15
                        Else
                            result = (Int(result / 15) + 1) * 15
                        End If
                    End If
                End If
        End Select
 
        If Right(calculS(N, 1), 1) = "€" Then
            resultFinal = Round(result, 2) & " €"
            calculS(N, 1) = Left(calculS(N, 1), Len(calculS(N, 1)) - 1)
        Else
            resultFinal = result
        End If
 
        Dim Idestination As Integer
        Idestination = QueliClasse(USF.Controls(calculS(N, 1)))
        If TypeNameByClasse(calculS(N, 1)) = "Label" Then LesControls(Idestination).LEControleClasseLBL.Caption = resultFinal
        If TypeNameByClasse(calculS(N, 1)) = "TextBox" Then LesControls(Idestination).LEControleClasseTXT.Value = resultFinal
 
 
Next J
End Sub
Sub CalculTotalUSF()
Dim STMat As Currency, STMin As Currency, STT As Currency
Dim TMat As Integer, TMin As Integer, TH As Integer, TT As Integer
STMat = 0
STMin = 0
STT = 0
 
Dim LeTag() As String
 
 
 
For i = 0 To UBound(LesControls) - 1    'on boucle sur touts les controle de l'USF
 
    'on vérifie que les controle ont une virgule dans le tag
    If InStr(LesControls(i).LeTag, ",") > 0 Then
        LeTag = Split(LesControls(i).LeTag, ",")    'création de varible du tag
        LenTag = UBound(LeTag)                      'combien de paire d'info dans le tag
        J = 0
 
        Select Case LeTag(UBound(LeTag) - 1)
            Case Is = "STMAT"
                STMat = STMat + SansE(LesControls(i).LEControleClasseLBL.Caption)
            Case Is = "STMIN"
                STMin = STMin + SansE(LesControls(i).LEControleClasseLBL.Caption)
            Case Is = "STT"
                STT = STT + SansE(LesControls(i).LEControleClasseLBL.Caption)
            Case Is = "TMAT"
                TMat = i
            Case Is = "TMIN"
                TMin = i
            Case Is = "TH"
                TH = i
            Case Is = "TT"
                TT = i
                Dim TotalPresentDansLUSF As Boolean
                TotalPresentDansLUSF = True
        End Select
    End If
Next i
If TotalPresentDansLUSF = True Then
    LesControls(TH).LEControleClasseLBL.Caption = Heure(Round(STMin, 2) / BAR.Cells(5, 3) * 60)
    LesControls(TMat).LEControleClasseLBL.Caption = Round(STMat, 2) & " €"
    LesControls(TMin).LEControleClasseLBL.Caption = Round(STMin, 2) & " €"
    LesControls(TT).LEControleClasseLBL.Caption = Round(STT, 2) & " €"
End If
If (STMat + STMin) * 1.01 > STT > (STMat + STMin) * 0.99 Then MsgBox "ATTENTION ERREUR DE CALCUL"
 
 
End Sub

Bon je persiste, et je ne comprend pas mon erreur

dans mon module de classe j'ai mit ca pour voir avec une valeur espionne et en mode pas a pas, le programe boucle uniquement la dessus comme si le bouton restait apuyé ...
Code:

1 2 3 4 5 Private Sub LEControleClasseCMB_Click() PasDeDblClick = PasDeDblClick + 1 If PasDeDblClick <= 1 Then IfChange If PasDeDblClick = 12 Then PasDeDblClick = 0 End Sub

Donc, ça marche ....... avec ce nouveau code ....
j'ai quitté excel .. relancé, et ça ne fait fait plus "que' 4 tour. :weird:
Un idée de pourquoi ?
indice pour cette enigme :
J'ai executé en pas à pas, la boucle ne resort pas de cette sub
La variable PasDeDblClick n'est pas utilisé à l'exterieur de cette sub
le premier des 4 tour est "gratuit" car est relatif au bouton de l'userform qui se ferme ...
Code:

1 2 3 4 5 6 Private Sub LEControleClasseCMB_Click() PasDeDblClick = PasDeDblClick + 1 If PasDeDblClick <= 1 Then IfChange If PasDeDblClick = 4 Then PasDeDblClick = 0 End Sub