Procédure simultanée - Erreur automation, une exception s'est produite

Version imprimable

26/09/2014, 15h38
lucasgaetan

1 pièce(s) jointe(s)

Procédure simultanée - Erreur automation, une exception s'est produite

Bonjour,

Je cherche à créer des procédures en simultanées
je m'inspire de la discussion du forum ici
après une petite modif pour avoir un UsFr "afficher l'heure" et un UsFr "afficher la position de la souris" (il me semble que s'est un bonne exemple pour créer des procédures en simultanées) je me retrouve avec un message d'erreur de vb: "Erreur automation, une exception s'est produite"
--> c'est un projet de faisabilité, du brouillon, pas à se soucier de la syntaxe

Si vous avez une piste car moi je me suis cassé les dents :aie:

PS voir fichier joint, RENOMMER L’EXTENSION EN .xlsm

Bonjour,

merci de poster le code conformément aux règles du forum, peu prendront le risque d'ouvrir une telle pièce jointe …

Démonstration fonctionnant comme un charme de mon côté :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Private Declare Function CreateThread& Lib "kernel32" (zero1 As Any, ByVal zero2&, _ ByVal lpStartAddress&, zero3 As Any, ByVal zero4&, empty1&) Private Declare Function CloseHandle& Lib "kernel32" (ByVal hObject&) Private Sub ProcessusParallele() MsgBox "Ca marche !!!" & Space$(18), , " Processus parallèle" End Sub Sub Demo() CloseHandle CreateThread(0, 0, AddressOf ProcessusParallele, 0, 0, Empty) MsgBox "Processus parallèle créé …", , " Programme source" End Sub
_________________________________________________________________________________________________
La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que l'on ne sait pourquoi.
Ici, nous avons réuni théorie et pratique : Rien ne fonctionne … et personne ne sait pourquoi ! (Albert Einstein)

OK, je pensais que c’était plus simple de mettre le fichier, j'ai zappé l'aspect sécurité.

Donc voici mon code
dans le module principale

Code:

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()
    UserForm2.Show
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)
    UserForm1.Show
    CloseHandle hThread
End Sub

dans le UserForm1 avec 2 textbox:

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
' Position de X et Y par rapport a l'écran
Private Declare Function GetCursorPos Lib "user32" ( _
    lpPoint As POINTAPI) As Long
 
' Position de X et Y par rapport a la fenètre et a GetCursorPos
Private Declare Function ScreenToClient Lib "user32" ( _
    ByVal hwnd As Long, _
    lpPoint As POINTAPI) As Long
 
Private Type POINTAPI
    X As Long
    Y As Long
End Type
 
' Affiche un point sous le curseur quand on clique sur la feuille
Private Sub UserForm_Click()
 
End Sub
 
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim pos As POINTAPI
GetCursorPos pos
ScreenToClient 0, pos
TextBox1.Text = pos.X
TextBox2.Text = pos.Y
End Sub

dans le UserForm2 avec un Label:

Code:

1
2
3
4
5
Private Sub UserForm_Activate()
    For i = 0 To 10000
        Label1.Caption = Now()
    Next i
End Sub

29/09/2014, 11h11
Marc-L

Plante pareil de mon côté, donc procédure parallèle à oublier avec un UserForm !

Et c'est peut-être inutile, voir l'aide de la propriété ShowModal d'un UserForm …
29/09/2014, 12h29
lucasgaetan

Citation:

Envoyé par Marc-L

voir l'aide de la propriété ShowModal d'un UserForm …

Déjà explorer

Merci pour ton temps