Discussion :

[Miss Ti]

Bonjour à tous,

Par le biais de VBA je cherche à contrôler une autre application.
Vu que l'autre application est utilisée pour visualiser les données autrement (c'est de la carto), je ne voudrais pas ouvrir X fois la même fenêtre.
D'où l'appel d'une procédure pour chaque bouton appelant la visualisation cartographique:

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub Gestion_logiciel_truc()
    ' teste si une fenêtre de ce logiciel est déjà ouverte
    Set Truc_obj = GetObject(, "Truc.Application")
    ' si ce n'est pas le cas, ouvrir une session
    If Truc_obj = Null Then
        'Ouverture du .wor et récupération de la main sur ce fichier
        ShellExecute 0, "open", CurrentProject.Path & "\data_carto\Carto_Mollusques.WOR", vbNullString, vbNullString, 3
        Set Truc_obj = GetObject(, "Truc.Application")
    End If
End Sub

Le problème est que la ligne Set Truc_obj = GetObject(, "Truc.Application") me donne le message suivant aucune fenêtre du logiciel truc n'est ouverte:

Un composant activeX ne peut créer d'objet

. Ce ne doit pas être la bonne méthode pour tester si l'application est ouverte mais je ne vois pas comment m'y prendre autrement...

Vous n'auriez pas une piste?
(au fait, c'est du Access 2000)

[LedZeppII]

Bonsoir,

Essaie de voir si tu peux t'en sortir avec un de ces liens.

Avec API : Eviter les multi instances d'une application

Acec WMI : Comment lister les processus actifs sans utiliser l'API Windows et Comment "tuer" un processus en mémoire
Tu dois pouvoir modifier «Comment "tuer" un processus en mémoire» de manière à créer une fonction qui recherche si un processus est exécuté et qui renvoie True/False.

A+

[Miss Ti]

Il semblerait que la source Eviter les multi instances d'une application soit exactement ce qu'il me faut. Merci pour le tuyau LedZeppII.

2 questions avant d'attaquer:
comment connaître le sApplicationPath quand l'éxécutale peut être à différents endroits selon les PC? (c'est pour une base qui sera transférée sur un autre PC)
comment connaître le WindowClassName de mon application?

[LedZeppII]

Bonsoir,

Pour la première question, si le programme est associé à une extension de fichier (ce qui semble être le cas vu la façon dont tu le lances) :
Comment récupérer l'exécutable associé à un fichier ?
Précision : la valeur retournée par la fonction API est >32 à en cas de succès.
Sinon les codes d'erreurs sont

Code vb :

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

1
2
3
Const SE_ERR_FNF As Long = 2        ' Fichier Non Trouvé
Const SE_ERR_NOASSOC As Long = 31   ' Pas de programme associé
Const SE_ERR_OOM As Long = 8        ' Plus de mémoire disponible

Pour la deuxième question, je vais te donner un bout de code que j'utilise.
Il faut le mettre dans un nouveau module de code et exécuter la dernière Sub.
Il imprime dans la fenêtre de déboguage des infos sur les fenêtres visibles.
Handle de fenêtre, N°PID, Classe Fenêtre, Titre fenêtre, Fichier du module associé à la fenêtre.
Classe et titre sont tronqués à 28 caractères s'ils sont trops longs. Dans ce cas le dernier caractère est ">".

Code vb :

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
Option Explicit
 
Declare Function EnumWindows Lib "user32.dll" _
        (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
 
Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" _
        (ByVal hWnd As Long, ByVal lpString As String, ByVal nMaxCount As Integer) As Integer
 
Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" _
        (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Integer
 
Declare Function GetWindowThreadProcessId Lib "user32.dll" _
        (ByVal hWnd As Long, ByRef lpdwProcessId As Long) As Long
 
Declare Function GetWindowModuleFileName Lib "user32.dll" Alias "GetWindowModuleFileNameA" _
       (ByVal hWnd As Long, ByVal lpszFileName As String, _
        ByVal cchFileNameMax As Integer) As Long
 
Declare Function IsWindowVisible Lib "user32.dll" (ByVal hWnd As Long) As Boolean
Declare Function IsChild Lib "user32.dll" (ByVal hwndParent As Long, ByVal hWnd As Long) As Boolean
 
Function EnumWindowProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
Dim strClassName As String, strWindowTitle As String
Dim strFileName As String, lngRetVal As Long
Dim strBuffer As String * 255, p As Integer, parentW As Long
Dim lngThread As Long, lngPID As Long
Dim strOut As String
 
    If IsWindowVisible(hWnd) Then
        lngThread = GetWindowThreadProcessId(hWnd, lngPID)
 
        strBuffer = String(255, vbNullChar)
        GetClassName hWnd, strBuffer, 255
        p = InStr(1, strBuffer, vbNullChar)
        If p > 1 Then strClassName = Left(strBuffer, p - 1)
 
        strBuffer = String(255, vbNullChar)
        GetWindowText hWnd, strBuffer, 255
        p = InStr(1, strBuffer, vbNullChar)
        If p > 1 Then strWindowTitle = Left(strBuffer, p - 1)
 
        strBuffer = String(512, vbNullChar)
        strFileName = ""
        lngRetVal = GetWindowModuleFileName(hWnd, strBuffer, 256)
        strFileName = Left(strBuffer, lngRetVal)
 
        If IsChild(Application.hWndAccessApp, hWnd) Then parentW = Application.hWndAccessApp Else parentW = 0
 
        strOut = String(80, " ")
        Mid$(strOut, 1, 8) = CStr(hWnd)
        Mid$(strOut, 10, 8) = CStr(lngPID)
 
        Mid$(strOut, 20, 28) = Left(strClassName, 28)
        If Len(strClassName) > 28 Then Mid$(strOut, 48, 1) = ">"
 
        Mid$(strOut, 50, 28) = Left(strWindowTitle, 28)
        If Len(strWindowTitle) > 28 Then Mid$(strOut, 78, 1) = ">"
 
        Debug.Print strOut & """" & strFileName & """"
    End If
    EnumWindowProc = 1
End Function
 
Sub EnumWindows1()
  EnumWindows AddressOf EnumWindowProc, 0
End Sub

Bien sur il faut que l'application dont on cherche le nom de classe de fenêtre soit ouverte pour apparaître dans la liste.

Bon courage et A+

[Jack78960]

Salut,
ce genre de code permet de faire ce que tu veux

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub Gestion_logiciel_truc()
    ' teste si une fenêtre de ce logiciel est déjà ouverte
    On Error Resume Next
    Set Truc_obj = GetObject(, "Truc.Application")
    ' si ce n'est pas le cas, ouvrir une session
    If Err <> 0 Then
        'Ouverture du .wor et récupération de la main sur ce fichier
        Set Truc_obj = CreateObject(, "Truc.Application")
    End If
End Sub

[Miss Ti]

En effet, Jack78960, ce genre de code peut m'aider... et ça marche au poil
Pourquoi faire compliqué quand ça peut être simple?


LedZeppII, merci quand même pour ton aide.

[LedZeppII]

Je n'ai pas bien lu ton message initial.
Je croyais que ton exécutable Truc n'était pas compatible COM.
Le fait que tu emploies ShellExecute m'a conforté à tord dans cette idée.

Merci à Jack78960. Au fait, nous sommes presque voisins. J'habite Montigny le bretonneux

A+