Une question sur VBA

Version imprimable

12/11/2013, 19h56
eliot.raymond

Une question sur VBA

Bonsoir a toutes et tous, forum bonsoir

Je souhaiterai svp juste savoir jusqu'a combien de controls (tout confondu, labels, textboxs etc etc) on peut mettre dans un userform aussi grand soit-il et si ils faut les répartir dans des Frames, sans que cela pose de problème avec la mémoire ou la gestion d'un grand nombre de controls.

En fait quel est le mieux svp a faire en cas de nombreux controls.

Merci pour les infos a ce sujet et pour vos conseils.

Bonne soirée a tous

Cdlt Ray
13/11/2013, 09h41
EngueEngue

Bonjour,

A partir d'une centaine de contrôles lourds, il peut y avoir des problèmes de ralentissements ou même d'erreurs. Le mieux est de splitter ton USF en plusieurs userforms plus légers et répartir le traitement..

Par exemple si tu as besoin de 100 textbox avec 100 labels et 5 boutons, ceci dans 3 frames. Tu ferais mieux de faire deux voir trois USF.
13/11/2013, 11h46
eliot.raymond

Salut a tous,

Salut EngueEngue

Merci pour ta réponse, c'est sympa, j'ai pu lire 2 /3 articles sur le nombres de controls par USF et visiblement pas tous d'accord.

Bon de toutes facons, je suis d'accord avec toi, diviser pour mieux règner, ca me va bien.

Si j'ai bien compris Ex: les controls qui sont dans l'userform(1) le code a mettre
pour les pilotés doit aller dans

Code:

Private Sub UserForm_Initialize()

de l'Usf (1)

Idem pour les controls se trouvant dans l'userform(2) etc etc

Merci pour tes infos et conseils

Vu l'heure bon app et a plus tard

Cdlt Ray
13/11/2013, 12h09
EngueEngue

Ton Private Sub UserForm_Initialize() va se lancer à l'initialisation de ton USF

Si tu veux faire qqchose en cliquant sur un label, un bouton ou autre il faudra le mettre dans leur propre Sub

Code:

Private Sub CommandButton1_Click()

Tu peux toujours essayer de blinder ton USF, quand tu commenceras à avoir des erreurs tu sauras que tu es à la limite..
13/11/2013, 13h54
eliot.raymond

Salut

Merci pour la réponse

je vois maintenant comment faire et utiliser plusieurs userforms en mème temps

je sais les affichées par 2 ou 3
je sais enlever la barre de titre
je sais cacher ou inbiber la croix de l'usf
je sais les déplacer mème lorsque la barre de titre n'ai plus

j'ai lu pleins de tutos pour bidouiller les Usf mais pas trouver
pour cacher, supprimer où changer la couleur du cadre de l'usf

ou écrire differement dans la barre de titre et changement de couleur du fond

pas encore trouver de code pour ce faire, une idée un lien peux etre ???

En tout cas merci pour ton aide, je progresse sur les usfs

Bonne après midi a toi

Cdlt Ray

Dans un module standard:

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
389
390
391
392
393
394
Option Explicit
 
Private Type POINTAPI
    x As Long
    y As Long
End Type
 
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Type LOGBRUSH
    lbStyle As Long
    lbColor As Long
    lbHatch As Long
End Type
 
Private Type PAINTSTRUCT
    hdc As Long
    fErase As Long
    rcPaint As RECT
    fRestore As Long
    fIncUpdate As Long
    rgbReserved(32) As Byte
End Type
 
 
Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As String * 1
    lfUnderline As String * 1
    lfStrikeOut As String * 1
    lfCharSet As String * 1
    lfOutPrecision As String * 1
    lfClipPrecision As String * 1
    lfQuality As String * 1
    lfPitchAndFamily As String * 1
    lfFaceName As String * 32
End Type
 
Private Declare Function CreateFontIndirect Lib "gdi32" _
Alias "CreateFontIndirectA" _
(lpLogFont As LOGFONT) As Long
 
Private Declare Function GetWindowDC Lib "user32" _
 (ByVal hwnd As Long) As Long
 
Private Declare Function SendMessage Lib "user32.dll" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any) As Long
 
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, _
ByVal hdc As Long) As Long
 
Private Declare Function TextOut Lib "gdi32" _
Alias "TextOutA" _
(ByVal hdc As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal lpString As String, _
ByVal nCount As Long) As Long
 
Private Declare Function SetBkMode Lib "gdi32" _
(ByVal hdc As Long, _
ByVal nBkMode As Long) As Long
 
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, _
ByVal hObject As Long) As Long
 
Private Declare Function SetWindowsHookEx Lib _
"user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
 
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
 
Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal ncode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
 
Private Declare Function GetCurrentThreadId Lib "kernel32" _
() As Long
 
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
 
Private Declare Function CallWindowProc Lib "user32" _
Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
 
Private Declare Function GetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
 
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
 
Private Declare Function SetTextColor Lib "gdi32" _
(ByVal hdc As Long, _
ByVal crColor As Long) As Long
 
Private Declare Function CreateBrushIndirect Lib "gdi32" _
(lpLogBrush As LOGBRUSH) As Long
 
Private Declare Function FillRect Lib "user32.dll" _
(ByVal hdc As Long, _
ByRef lpRect As RECT, _
ByVal hBrush As Long) As Long
 
Private Declare Function SetRect Lib "user32" _
(lpRect As RECT, _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long) As Long
 
Private Declare Function GetWindowRect Lib "user32.dll" _
(ByVal hwnd As Long, _
ByRef lpRect As RECT) As Long
 
Private Declare Function BeginPaint Lib "user32.dll" _
(ByVal hwnd As Long, _
ByRef lpPaint As PAINTSTRUCT) As Long
 
Private Declare Function EndPaint Lib "user32.dll" _
(ByVal hwnd As Long, _
ByRef lpPaint As PAINTSTRUCT) As Long
 
Private Declare Function DeleteDC Lib "gdi32" _
(ByVal hdc As Long) As Long
 
Private Declare Function RedrawWindow Lib "user32" _
(ByVal hwnd As Long, _
lprcUpdate As Any, _
ByVal hrgnUpdate As Long, _
ByVal fuRedraw As Long) As Long
 
Private Declare Function InvalidateRect Lib "user32.dll" _
(ByVal hwnd As Long, _
ByVal lpRect As Long, _
ByVal bErase As Long) As Long
 
Private Declare Function SetCursorPos Lib "user32.dll" _
(ByVal x As Long, _
ByVal y As Long) As Long
 
Private Declare Function GetCursorPos Lib "user32.dll" _
(ByRef lpPoint As POINTAPI) As Long
 
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
 
Private Const WH_CBT As Long = 5
Private Const HCBT_ACTIVATE As Long = 5
Private Const GWL_WNDPROC As Long = -4
 
Private Const WM_ACTIVATE As Long = &H6
Private Const WM_PAINT As Long = &HF&
Private Const WM_SHOWWINDOW As Long = &H18
Private Const WM_EXITSIZEMOVE As Long = &H232
Private Const WM_DESTROY As Long = &H2
 
Private Const RDW_INTERNALPAINT As Long = &H2
 
Private Const SM_CXSCREEN As Long = 0
Private Const SM_CYSCREEN As Long = 1
Private Const SM_CYCAPTION As Long = 4
 
Private tPoint As POINTAPI
Private tRect As RECT
Private lPrevWnd As Long
Private lhHook As Long
Private bHookEnabled As Boolean
Private oForm As Object
Private sCaptionText As String
Private lCaptionColour As Long
Private lFontSize As Long
Private lFontColour As Long
Private bBold As Boolean
 
Sub HookUserForm _
 (ByVal Form, ByVal CaptionColour, _
 ByVal FontColour, ByVal FontSize, ByVal Bold)
 
    'install a cbt hook to monitor for
    'the activation of a window.
    If Not bHookEnabled Then
        'store parms in mod level vars.
        Set oForm = Form
        sCaptionText = Form.Caption
        lCaptionColour = CaptionColour
        lFontColour = FontColour
        lFontSize = FontSize
        bBold = Bold
        lhHook = SetWindowsHookEx _
        (WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)
        bHookEnabled = True
        'show userform.
        Form.Show
    Else
        MsgBox "The hook is already set.", vbInformation
    End If
 
End Sub
 
Private Sub TerminateHook()
 
   'important to unhook when done!
    UnhookWindowsHookEx lhHook
    bHookEnabled = False
 
End Sub
 
Private Function HookProc _
(ByVal idHook As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
 
    Dim sBuffer As String
    Dim lRetVal As Long
 
    'check if a window has been activated.
    If idHook = HCBT_ACTIVATE Then
 
    'if so,get it's class name.
    sBuffer = Space(256)
    lRetVal = GetClassName(wParam, sBuffer, 256)
 
    'check if it is an xl userform window
    'that is being activated.
 
    If Left(sBuffer, lRetVal) = "ThunderDFrame" Or _
    Left(sBuffer, lRetVal) = "ThunderXFrame" Then
 
    'if so,subclass it .
    lPrevWnd = SetWindowLong _
    (wParam, GWL_WNDPROC, AddressOf CallBackProc)
 
    'done. so remove CBT hook.
    Call TerminateHook
    End If
 
    End If
 
    'Call next hook.
    HookProc = CallNextHookEx _
    (lhHook, idHook, ByVal wParam, ByVal lParam)
 
End Function
 
Private Function CallBackProc _
(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
 
    Dim lDc As Long
 
    On Error Resume Next
    'get current userform position.
    GetWindowRect hwnd, tRect
    Select Case Msg
        Case WM_PAINT, WM_ACTIVATE
            If Msg = WM_ACTIVATE Then
                Call MoveCursor
            End If
            lDc = GetWindowDC(hwnd)
            Call DrawTitleBar(hwnd, lCaptionColour)
            SetBkMode lDc, 1
            SetTextColor lDc, lFontColour
            CreateFont lDc, Bold:=bBold
            TextOut lDc, 6, GetSystemMetrics(SM_CYCAPTION) / 3, _
            sCaptionText, Len(sCaptionText)
            ReleaseDC hwnd, lDc
            InvalidateRect hwnd, 0, 0
        Case WM_EXITSIZEMOVE, WM_SHOWWINDOW
            If Msg = WM_SHOWWINDOW Then
                SetCursorPos tPoint.x, tPoint.y
            End If
            SendMessage hwnd, WM_PAINT, 0, 0
            Call MoveCursor
        Case WM_DESTROY
            SetWindowLong hwnd, GWL_WNDPROC, lPrevWnd
    End Select
 
    'process other msgs.
    CallBackProc = CallWindowProc _
    (lPrevWnd, hwnd, Msg, wParam, ByVal lParam)
 
End Function
 
Private Sub CreateFont(DC As Long, Optional Bold As Boolean)
 
    Dim uFont As LOGFONT
    Dim lNewFont As Long
 
    With uFont
        .lfFaceName = "Tahoma" & Chr$(0)
        .lfHeight = lFontSize
        .lfWidth = 8
        .lfWeight = IIf(Bold, 900, 100)
    End With
 
    lNewFont = CreateFontIndirect(uFont)
    DeleteObject (SelectObject(DC, lNewFont))
 
End Sub
 
Private Sub DrawTitleBar _
(lhwnd As Long, Color)
 
    Dim tPS As PAINTSTRUCT
    Dim tLB As LOGBRUSH
    Dim tR As RECT
    Dim lDc As Long
    Dim l As Long
    Dim hBrush As Long
 
    BeginPaint lhwnd, tPS
    lDc = GetWindowDC(lhwnd)
    tLB.lbColor = Color
    'Create a new brush
    hBrush = CreateBrushIndirect(tLB)
 
    With oForm
        SetRect tR, 0, 0, GetSystemMetrics _
        (SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN)
    End With
    'Fill the form with our brush
'    FillRect lDc, tR, hBrush
      FillRect lDc, tR, hBrush
 
    Call DeleteObject(hBrush)
    RedrawWindow lhwnd, ByVal 0&, ByVal 0&, RDW_INTERNALPAINT
    DeleteDC lDc
    Call EndPaint(lhwnd, tPS)
 
End Sub
 
Private Sub DrawCloseButton()
 
    DoEvents
    SetCursorPos tPoint.x, tPoint.y
 
End Sub
 
Private Sub MoveCursor()
 
    GetCursorPos tPoint
    SetCursorPos tRect.Right - 15, tRect.Top + 15
    Application.OnTime Now + TimeSerial(0, 0, 0.1), _
    "DrawCloseButton"
 
End Sub
 
'=========Wrapper function===============.
Sub ShowFormatedUserForm( _
 _
    ByVal Form As Object, _
    ByVal CaptionColor As Long, _
    Optional ByVal FontColour As Long = vbWhite, _
    Optional ByVal FontSize As Long = 12, _
    Optional ByVal Bold As Boolean = False)
        Call HookUserForm _
 _
            (ByVal Form, _
            ByVal CaptionColor, _
            ByVal FontColour, _
            ByVal FontSize, _
            ByVal Bold)
End Sub

Puis:

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub Test()
 
Call ShowFormatedUserForm( _
 _
    Form:=UserForm1, _
    CaptionColor:=vbMagenta, _
    FontColour:=vbYellow, _
    FontSize:=14, _
    Bold:=True)
 
End Sub

Sinon une autre technique de bidouillage assez salace: tu hides ta barre de titre du USF et à la place tu mets un label que tu pourras bidouiller...

Je n'ai jamais rendu hipster mes USF, d'une part parce que c'est inutile, et d'une autre parce que le contenu est plus important que le contenant, préoccupe toi de rendre ton usf opérationnel avant de le rendre funky :)

13/11/2013, 14h32
eliot.raymond

Salut

Merci pour le code, je vais essayer ca dès que possible.

Mais tu raison une fois de plus, mais c'est bon aussi pour la formation, ca apprends a manipuler et de voir ce qui est possible de faire.

Toutefois je suis parfaitement conscient qu"excel reste avant toute chose un tableur

et non de quoi s'amuser a jouer les picassos, mais c'est interressant sur le plan programmation.

j'essais ca plus tard, un boulot a faire auparavant.

Encore merci pour ton savoir partagé.

Cordialement Ray
13/11/2013, 16h28
eliot.raymond

1 pièce(s) jointe(s)

Salut

j'ai fait l'essai de ton code j'ai une belle Userform avec barre de titre et un cadre rose

J'ai poster un petit fichier avec 3 Userform

comment puis-je faire pour enlever

sur l'USF(1) le trait horizontal du bas
sur l'USF(2) le trait horizontal du haut et celui du bas
sur l'USF(3) le trait horizontal du haut

ceci afin de donner une fois les 3 USF avec un fond de mème couleur
l'illusion qu'il y a qu'une seule USF, si bien sur c'est possible :mouarf:

a plus tard et merci

Ray
13/11/2013, 16h38
EngueEngue

Belle... Question de goûts.

Cela dépasse mes compétences et à part le bordercolor je ne vois pas ce que tu peux faire.

Pourquoi ne pas faire une seule USF ?
13/11/2013, 17h02
eliot.raymond

Hé bien pour placer beaucoup de controls et mettre en pratique et pour voir comment ca marche

pour l'instant des essais après j'ai un programme en vue.

Merci
13/11/2013, 17h11
EngueEngue

Si tu les ouvres en même temps ça revient au même et c'est même pire...

Tu auras le même nombre de controles ouverts.. et en plus trois USF...qui devront être en modal.. La galère monstre.
13/11/2013, 17h33
eliot.raymond

Re

Je comprends bien ta réponse, je te remercie, bon alors visiblement je n'ai pas tout compris :oops:

je voulais refaire ma compta qui c'est planter lors d'un enregistrement justement trop de controls dans l'usf et excel n'a pas aimer et depuis le fichier est mort

j'utilise en attendant mon ancien fichier

je voulais refaire le fichier via Userform et feuille excel et piloter le tout avec l'Userform

la compta n'ai pas compliquer, je n'ai pas un salaire de ministre :cry:

voila le but que je m'était fixe,r étant a la retraite, j'ai le temps de mi coller.

Merci
13/11/2013, 17h37
EngueEngue

Pour ta compta: Money Manager Ex Gratuit et bien plus puissant qu'Excel (Sans faire de pub)

Si tu veux des USF... La règle= un USF à la fois avec moins de 200 contrôles.
13/11/2013, 18h05
eliot.raymond

Le but était de faire moi mème le fichier
Sinon Ok bien compris je vais revoir ca maintenant que j'en sais plus
donc les Frames c'est pour regrouper des controls et pour faire joli.

Merci pour Money Manager, je vais regarder je ne connais pas

Ray
13/11/2013, 19h34
parmi

Bonjour,

Une question que je me pose...
Pourquoi autant de contrôles ?

Il existe des grilles (listview), des listbox (jusqu'à 10 colonnes possibles) ou combobox,...

Peut-être que tu devrais repenser ton ou tes Userforms (?)
14/11/2013, 08h01
eliot.raymond

Salut parmi,

Pour répondre a ta question, c'est que je ne suis pas plus balèze que ça en VBA.

Faire de la présentation et manipuler Excel ca oui, gérer un peu aussi.

MAIS de la à mettre tout ca en oeuvre Houla, on sera pas loin de noël 2999, quand j'aurai fini mon programme :lol:

Malgré tout je me débrouille bien quand mème.

Voila, merci de t'interesser a mon post.

Une bonne journée a toi

Cordialement Ray