Discussion :

[daveb123]

Bonjour à vous tous,

Ma question est simple, est-il possible de lancer deux procédure qui doivent s'éxecutée simultanéement en VBA excel?

Exemple, je clique sur un bouton: D'une part j'ai mon horloge (que je codé) qui s'incrémente à chaque seconde dans une cellule quelconque et d'autre part un code qui éxecute un programme plus complexe ex. boucles et opération mathématiques etc.

Merci pour vos réponses, j'ai fouillé sur le forum mais je n'ai pas trouvé!

[Ben_L]

Bonjour,

Il est possible de lancer une tâche asynchrone en utilisant l'API Windows CreateThread.
Par exemple:

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
Option Explicit
 
Private Declare Function CreateThread Lib "kernel32" (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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
Private Sub TacheAsynchrone()
    MsgBox "Ca marche !!!"
End Sub
 
Public Sub Lanceur()
    Dim hThread As Long, hThreadID As Long
    hThread = CreateThread(ByVal 0&, ByVal 0&, AddressOf TacheAsynchrone, ByVal 0&, ByVal 0&, hThreadID)
    MsgBox "Le processus asynchrone a été créé."
    CloseHandle hThread
End Sub

Le code situé après l'instruction CreateThread sera exécuté "parallèlement" au code de la Sub TacheAsynchrone.

Cdt

[Docmarti]

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
 
Private Sub CommandButton3_Click()
 
Call Demarre_Horloge
 
 Worksheets("feuil1").Protect Password:="", UserInterfaceOnly:=True
 
 Cells(1, 4).Value = Cells(1, 1).Value
 
For i = 1 To 10000
 Cells(1, 2).Value = i
 Cells(1, 3).Value = Cells(1, 1).Value
 DoEvents
Next
Cells(1, 5).Value = Cells(1, 1).Value
 
Call Arreter_Horloge
 
Worksheets("feuil1").Unprotect Password:=""
 
 
End Sub

Dans un module :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Global ProchainAppel
 
Sub Demarre_Horloge()
Worksheets("Feuil1").Cells(1, 1).Value = Now
ProchainAppel = Now + TimeValue("00:00:01")
 Application.OnTime ProchainAppel, "Demarre_Horloge", , True
 
End Sub
 
Sub Arreter_Horloge()
On Error Resume Next
Application.OnTime ProchainAppel, "Demarre_Horloge", , False
End Sub

Dans ThisWorkBook :

Code :

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

1
2
3
4
5
Private Sub Workbook_BeforeClose(Cancel As Boolean)
 
 Call Arreter_Horloge
 
End Sub

[Invité]

Bonjour,

Encore une superbe réponse de Ben_L. J'allais justement commencer à m'intéresser au Multitreading sous Excel. Ça tombe très bien

Ça requière plusieurs modif en 64 bit par contre.

[Ben_L]

Bonjour Nouveau2,

Merci pour tes encouragements. Ça fait plaisir de voir que mes contributions sont appréciées

Concernant l'utilisation en environnement 64 bits, je serais très intéressé par tes éventuels retours. Quelles sont les modifs à appliquer ?
Ma version d'Office n'est pas en 64 bits. Je ne peux donc pas réaliser de tests par moi-même pour l'instant.

A+

[Invité]

De rien, tu les mérite.

En 64 bits, c'est jamais aussi simple pour un débutant comme moi, puisqu'il n'y a pas beaucoup de code dispo sur le net qui soit fonctionnel en 64 bit.

Je sais que ton code peut marcher. Il y a des codes similaire ou identique, mais en x64, je n'ai pas encore trouvé.

Pour l'instant, j'ai ceci (mais marche pas):

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
Option Explicit
 
#If VBA7 Then
' à voir
Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
' ------------ Théoriquement OK, en pratique ... : Début ---------------
Private Declare PtrSafe Function CreateThread Lib "kernel32" ( _
        lpThreadAttributes As SECURITY_ATTRIBUTES, _
        ByVal dwStackSize As LongPtr, _
        lpStartAddress As LongPtr, _
        lpParameter As Any, _
        ByVal dwCreationFlags As Long, _
        lpThreadId As Long) As LongPtr
 
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As LongPtr
    bInheritHandle As Long
End Type
 
Declare PtrSafe Function CreateRemoteThread Lib "kernel32" ( _
        ByVal hProcess As LongPtr, _
        lpThreadAttributes As Any, _
        ByVal dwStackSize As LongPtr, _
        lpStartAddress As LongPtr, _
        lpParameter As Any, _
        ByVal dwCreationFlags As Long, _
        lpThreadId As Long) As LongPtr
 
Declare PtrSafe Function GetCurrentThread Lib "kernel32" () As LongPtr
Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Declare PtrSafe Function SetThreadPriority Lib "kernel32" (ByVal hThread As LongPtr, ByVal nPriority As Long) As Long
Declare PtrSafe Function GetThreadPriority Lib "kernel32" (ByVal hThread As LongPtr) As Long
' ------------ Théoriquement OK, en pratique ... : Fin ---------------
 
'Non OK
'Declare PtrSafe Function GetThreadTimes Lib "kernel32" (ByVal hThread As LongPtr, lpCreationTime As FILETIME, lpExitTime As FILETIME, lpKernelTime As FILETIME, lpUserTime As FILETIME) As Long
 
Declare PtrSafe Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)
Declare PtrSafe Function TerminateThread Lib "kernel32" (ByVal hThread As LongPtr, ByVal dwExitCode As Long) As Long
Declare PtrSafe Function GetExitCodeThread Lib "kernel32" (ByVal hThread As LongPtr, lpExitCode As Long) As Long
 
'Non OK
'Declare PtrSafe Function GetThreadSelectorEntry Lib "kernel32" (ByVal hThread As LongPtr, ByVal dwSelector As Long, lpSelectorEntry As LDT_ENTRY) As Long
 
Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As LongPtr, lpdwProcessId As Long) As Long
 
Declare PtrSafe Function Beep Lib "kernel32" (ByVal dwFreqHz As Long, ByVal dwDurationMs As Long) As Long
 
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwDurationMs As LongPtr)
 
#Else
'---
#End If

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 TacheAsynchrone()
    MsgBox "Ca marche !!!"
End Sub
 
Private Sub Son() ' Audio
' Audio
Dim Son(1 To 16) As Double, L As Byte
For L = LBound(Son) To UBound(Son)
Son(1) = Beep(800 * 2 ^ (1 / L), 200) 'c'est pas une symphonie enfaite
Sleep 75
DoEvents
Next L
End Sub 
 
Public Sub Lanceur()
   #If VBA7 Then
       Dim hThread As LongPtr
   #Else
       Dim hThread As Long
   #End If
    Dim hThreadID As Long
 
    hThread = CreateThread(0&, ByVal 0&, AddressOf Son, ByVal 0&, 0&, hThreadID)
    MsgBox "Le processus asynchrone a été créé."
 
    Stop
    CloseHandle hThread
 
End Sub

Je ne sais pas quoi mettre à SECURITY_ATTRIBUTES, et si je met Any à la place, ça plante.

[Ben_L]

C'est la première fois que je vois du code VBA 64 bits. Intéressant !
Je n'ai rien trouvé qui puisse t'aider directement pour CreateThread.

Toutefois, cette source semble indiquer que le type de données 'SIZE_T' (pour 'dwStackSize') doit être défini comme un IntPtr.

A part ça, si l'API CreateProcess t'intéresse aussi, cette page présente un exemple d'utilisation en x64.
Elle laisse d'ailleurs penser qu'utiliser SECURITY_ATTRIBUTES dans une déclaration d'API ne pose pas de problème.