Usage VbComponent pour USF dynamique

**_C14_** · 03/07/2013, 10h22

Bonjour, mon projet est de créer une classe permettant de générer « à la volée » une UserForm pour réaliser des saisies ceci pour une table quelconque. Les zones de saisies sont donc dépendantes du nombre de colonnes de la table.
Je me suis largement inspiré des tutos etc de Dev…

Ayant plusieurs problèmes à solutionner, je vous les pose tout de go !
• Lors de la création de l’Usf avec
F_W = le nom de la feuille qui contient la Table

Code :

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

1
2
3
4
5
6
7
8
9
 
Set Usf = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
With Usf
    .Name = Nom_USF
    .Properties("Caption") = "FAIRE UNE SAISIE EN TABLE : " & F_W
    .Properties("Width") = 300
    .Properties("Height") = 200
    .Properties("StartUpPosition") = 1
End With

J’ai parfois une erreur 75 et je n’arrive pas à localiser l’erreur de code ?

• Les TextBox « montent » correctement mais je n’arrive pas à récupérer les saisies, c’est pourquoi il y a un mouchard permettant de suivre la chose, à priori les noms des TextBox sont OK mais les Values sont vides ?

J’ai l’impression que le souci « tourne » autour d’une instance de l’USF pas tout fait à stable car si j’utilise l’Usf crée (donc sans la détruire avec remove), mon code pour le CMD Valider est opérationnel et donc les saisies prises en comptes !

Voici l’intégralité du code utilisé :

Pour la Classe O_USER_FORM :

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
 
Option Explicit ' Version du 2 juillet 2013
 
Private Usf As Object
Private Legende As Object
Private Saisie As Object
 
Private mF_W As String
Private mNom_USF As String
Private mCOMPTEUR_L As Integer
Private mCOMPTEUR_C As Integer
 
Public Property Get Nom_USF() As String: Nom_USF = mNom_USF: End Property
Public Property Let Nom_USF(ByVal Nom_USF As String): mNom_USF = Nom_USF: End Property
Public Property Get F_W() As String: F_W = mF_W: End Property
Public Property Let F_W(ByVal F_W As String): mF_W = F_W: End Property
Public Property Get COMPTEUR_L() As Integer: COMPTEUR_L = mCOMPTEUR_L: End Property
Public Property Let COMPTEUR_L(ByVal COMPTEUR_L As Integer): mCOMPTEUR_L = COMPTEUR_L: End Property
Public Property Get COMPTEUR_C() As Integer: COMPTEUR_C = mCOMPTEUR_C: End Property
Public Property Let COMPTEUR_C(ByVal COMPTEUR_C As Integer): mCOMPTEUR_C = COMPTEUR_C: End Property
 
Public Sub Class_Initialize()
MsgBox "mouchard INIT LA CLASSE"
F_W = "W"
Nom_USF = "TELLE_USF"
COMPTEUR_L = derLIGNE
COMPTEUR_C = derCOL
 
End Sub
 
Sub Appel_USERFORM_V2()
Dim ws As Worksheet: Set ws = Application.Sheets(F_W)
 
Dim X As Object: Set X = CREATION_UserForm
 
'AFFICHE L'USER FORM
With ws
    .Activate
    X.Show
End With
 
'DESTRUCTION DE L'USER FORM A SA CLOTURE CAR LA MACRO A TJRS LA MAIN
ThisWorkbook.VBProject.VBComponents.Remove Usf
Set Usf = Nothing
MsgBox "L'USF est détruite ! "
 
Set X = Nothing
Set ws = Nothing
 
Application.DisplayAlerts = False
    ThisWorkbook.Save
Application.DisplayAlerts = True
 
End Sub
 
 
 
Private Function CREATION_UserForm() As Object
'DCL les Variables locales
Dim j As Integer
 
'DCL les objets
Dim ws As Worksheet: Set ws = Application.Sheets(F_W)
ReDim str_BlaBla(1 To COMPTEUR_C) As String
 
Set Usf = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
With Usf
    .Name = Nom_USF
    .Properties("Caption") = "FAIRE UNE SAISIE EN TABLE : " & F_W
    .Properties("Width") = 300
    .Properties("Height") = 200
    .Properties("StartUpPosition") = 1
End With
 
'*****************************************************************
'           AUTO ECRITURE DES LIGNES DE CODES ASSOCIEES
'*****************************************************************
With Usf.CodeModule
    j = .CountOfLines
'**********************  CODE DU CMD VALIDER  ********************
    .InsertLines j + 1, "Sub VALID_Click():dim MonTEXT as string:MonTEXT=""ENTRE DANS VALIDER """
    .InsertLines j + 2, "Msgbox MonTEXT"
    .InsertLines j + 3, "Dim U as O_USER_FORM"
    .InsertLines j + 4, "Set U = New O_USER_FORM"
    .InsertLines j + 5, "Call U.VALIDER"
    .InsertLines j + 6, "Me.Hide"
    .InsertLines j + 7, "End Sub"
 
'**********************  CODE DU CMD QUITTER  ********************
    .InsertLines j + 8, "Sub QUITT_Click():dim MonTEXT as string:MonTEXT=""ENTRE DANS QUITTER """
    .InsertLines j + 9, "Msgbox MonTEXT"
    .InsertLines j + 10, "Me.Hide"
    .InsertLines j + 11, "End Sub"
End With
 
'*****************************************************************
'                   GESTION DES CMD DE BASE
'*****************************************************************
Call Faire_CMD_VALID
Call Faire_CMD_QUITTER
 
'*****************  BOUCLE SUR LES LABELS ET TEXT BOX  ***********
Dim i As Integer
    For i = 1 To COMPTEUR_C
        str_BlaBla(i) = ws.Cells(1, i).Value
        Call Constructeur_Label(i, str_BlaBla(i))
        If i > 1 Then
            Call Constructeur_SAISIE(i, str_BlaBla(i))
        Else
            Call Faire_NUM
        End If
    Next i
'******************************************************************
 
VBA.UserForms.Add (Usf.Name)
Set CREATION_UserForm = UserForms(UserForms.Count - 1)
End Function
 
 
Public Sub VALIDER()
 
Dim MonTEXT As String: MonTEXT = "HELLO IN VALIDER"
Dim ws As Worksheet: Set ws = Application.Sheets(F_W)
Dim i As Integer: i = 1
Dim Max_Col As Integer: Max_Col = derCOL
Dim Num_Ligne As Integer: Num_Ligne = derLIGNE + 1
ReDim TabloSAISIES(1 To Max_Col)
Dim Nom_TBX As String: Nom_TBX = "TextBox"
Dim F As Control
Dim O As UserForm: Set O = TELLE_USF
 
For Each F In TELLE_USF.Controls
    If F.Name = Nom_TBX & i Then
'**** MOUCHARD SUR TEXTBOX ****
        MsgBox "F.Name = " & F.Name & ", F.Value = " & F.Value
'******************************
        TabloSAISIES(i) = F.Value
        i = i + 1
    End If
Next F
 
With ws
    .Activate
    For i = 1 To Max_Col
        .Cells(Num_Ligne, i + 1).Value = TabloSAISIES(i)
    Next i
End With
 
MsgBox "Sort de VALIDER"
 
Set ws = Nothing
Set O = Nothing
 
End Sub
 
'********************************************************************
'                 GENERE LES OBJETS DE L'INTERFACE
'********************************************************************
'CMD VALIDATION DES SAISIES
Private Function Faire_CMD_VALID()
Set Legende = Usf.Designer.Controls.Add("Forms.CommandButton.1")
With Legende
    .Name = "VALID"
    .Width = 60
    .Left = 220
    .Top = 1
    .Height = 20
    .Caption = "VALIDER"
End With
Set Legende = Nothing
End Function
 
'CMD QUITTER DE LA BD SAISIE
Private Function Faire_CMD_QUITTER()
Set Legende = Usf.Designer.Controls.Add("Forms.CommandButton.1")
With Legende
    .Name = "QUITT"
    .Width = 60
    .Left = 100
    .Top = 1
    .Height = 20
    .Caption = "QUITTER"
End With
Set Legende = Nothing
End Function
 
'INTITULES DES CHAMPS DE TABLE
Private Function Constructeur_Label(Indice As Integer, str_BlaBla As String)
Set Legende = Usf.Designer.Controls.Add("Forms.Label.1")
With Legende
    .Width = 100
    .Left = 5
    .Top = 1 + (20 * Indice - 1)
    .Height = 20
    .Caption = "Ma legende = " & str_BlaBla
End With
Set Legende = Nothing
End Function
 
'AFFICHE SOUS FORME DE LABEL, L'INDEX DE LA NOUVELLE SAISIE
Private Function Faire_NUM()
Set Legende = Usf.Designer.Controls.Add("Forms.Label.1")
With Legende
    .Width = 100
    .Left = 100
    .Top = 20
    .Height = 20
    .Caption = COMPTEUR_L
End With
Set Legende = Nothing
End Function
 
'TEXT BOX DES SAISIES UTILISATEUR
Private Function Constructeur_SAISIE(Indice As Integer, str_BlaBla As String)
Set Saisie = Usf.Designer.Controls.Add("Forms.TextBox.1")
With Saisie
    .Width = 100
    .Left = 100
    .Top = 1 + (20 * Indice - 1)
    .Height = 15
End With
Set Saisie = Nothing
End Function
 
'********************************************************************
'        GENERE LES INDICES DE FIN DE LIGNE ET DE COLONNE
'********************************************************************
Private Function derLIGNE() As Integer
Dim NbLignes As Integer
Dim ws As Worksheet: Set ws = Application.Sheets(F_W)
    With ws
        .Activate
        NbLignes = ActiveSheet.UsedRange.Rows.Count
    End With
Set ws = Nothing
derLIGNE = NbLignes
'MsgBox " NbLignes = " & NbLignes
End Function
 
Private Function derCOL() As Integer
Dim NbCol As Integer
Dim ws As Worksheet: Set ws = Application.Sheets(F_W)
    With ws
        .Activate
        NbCol = ActiveSheet.UsedRange.Columns.Count
    End With
Set ws = Nothing
derCOL = NbCol
'MsgBox "NbCol = " & NbCol
End Function

Pour le module d’appel de la classe :

Code :

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

1
2
3
4
5
 
Sub testerUserForm()
Dim U As O_USER_FORM: Set U = New O_USER_FORM
Call U.Appel_USERFORM_V2
End Sub

Avec une feuille nommée « W » comportant des étiquettes de colonnes et les lignes destinées aux saisies.

Merci par avance pour vos lumières, cordialement.

**Ben_L** · 03/07/2013, 15h31

Bonjour,

Vous pouvez déclarer dynamiquement un objet et définir certaines de ses méthodes en utilisant un module de classe.

Dans le module de classe, ajoutez un objet (par exemple un CommandButton) en utilisant l'instruction WithEvents.
A l'intérieur de ce module de classe, vous pourrez alors définir une Sub qui sera lancée dès que l'utilisateur cliquera sur le bouton en question.

Je vais essayer de vous fournir un exemple basé sur votre code dans le courant de la journée.
D'ici là, ce message devrait vous éclairer un peu plus sur la méthode à utiliser.

Cdt

En pièce jointe le fichier modifié que je vous propose.

J'ai fait mon possible pour simplifier le code autant que je le pouvais. En fonction de l'utilisation exacte que vous souhaitez faire de ce code, il se pourrait que certaines améliorations doivent être apportées.

N'hésitez pas si vous avez des questions.

Cdt

**_C14_** · 04/07/2013, 06h57

Je regarde votre fichier dans le détail et vous retourne très certainement qlqs questions mais en voici déjà une. Dans la logique que j'avais utilisé, j'avais besoin de maîtriser le nom de l'Usf d'après vous est-ce que cela était une source d'erreur 75 ceci pour ma gouverne futur ! Je vous remercie pour votre fichier et vous tient informé, bien cordialement.

**Ben_L** · 04/07/2013, 12h17

J'ai fait quelques recherches sur l'erreur 75 mais n'est rien trouvé qui me permette de comprendre pourquoi elle survient dans votre cas.

La raison de la modification proposée pour façon de gérer la UserForm est la suivante : utiliser l'objet VBComponent pose problème chez moi. Il me semble que cela provient du niveau de sécurité appliqué aux macros.
En définissant la UserForm "en dur", on peut éviter de l'ajouter dynamiquement au projet via du code VBA et se limiter à la mettre en forme au moment où on l'appelle.

Cdt

Usage VbComponent pour USF dynamique

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager