ProgressBar dans un Thread
Salut,
je rencontre quelques soucis pour gérer une progressBar dans un Thread.
Je rencontre deux types d'erreur :
- Si je charge le UserForm au sein du Thread, Excel se plante violemment (rapport d'erreur à envoyer chez Bill etc).
- Si Je charge le UserForm dans le Module parent du Thread, et que le Thread essaie de mettre à jour la progressBar de ce UserForm, j'ai une erreur 7 Mémoire insuffisante (en fait je pense plutôt qu'il s'agit d'une violation de mémoire car le UserForm n'a pas été crée dans la même stack)
Rien ne parle plus qu'une exemple simple :
Cas 1 qui génére le rapport d'erreur :
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
|
Option Explicit
Private Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Private Sub execThread()
Dim i As Integer
Dim t As Single
UserForm1.Show vbModeless
DoEvents
For i = UserForm1.ProgressBar1.Min To UserForm1.ProgressBar1.Max
UserForm1.ProgressBar1.Value = i
t = Timer
Do While Timer < (t + 0.1!)
DoEvents
Loop
Next
Unload UserForm1
End Sub
Public Sub main()
Dim lL_handle As Long
Dim lL_threadId As Long
lL_handle = CreateThread(ByVal 0&, ByVal 0&, AddressOf execThread, ByVal 0&, 0, lL_threadId)
End Sub |
Cas 2 qui génère l'erreur 7 Mémoire insuffisante :
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
|
Option Explicit
Private Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Private Sub execThread()
Dim i As Integer
Dim t As Single
For i = UserForm1.ProgressBar1.Min To UserForm1.ProgressBar1.Max
UserForm1.ProgressBar1.Value = i
t = Timer
Do While Timer < (t + 0.1!)
DoEvents
Loop
Next
Unload UserForm1
End Sub
Public Sub main()
Dim lL_handle As Long
Dim lL_threadId As Long
UserForm1.Show vbModeless
DoEvents
lL_handle = CreateThread(ByVal 0&, ByVal 0&, AddressOf execThread, ByVal 0&, 0, lL_threadId)
End Sub |
D'avance merci à tous ceux qui se pencheront sur le problème.
