XL 2010 Savoir si la calculatrice est présente ou pas

Magic_Doctor

XLDnaute Barbatruc
Bonsoir,

À partir d'un CommandButton que j'ai nommé perspicacement "Bouton_Calculatrice" je peux appeler la calculatrice :
VB:
Private Sub Bouton_Calculatrice_Click()
'CommandButton "Bouton_Calculatrice" permettant d'afficher la calculatrice

Application.ScreenUpdating = False

Dim x
      
     x = Shell("C:\Windows\System32\calc.exe", 1)

Range("C2500").Select: Application.ScreenUpdating = True

End Sub
Mais si, pour des raisons éthyliques, on clique plusieurs fois de suite sur ce même bouton, à chaque fois apparaîtra une nouvelle calculatrice.
Je voudrais tout simplement court-circuiter cet appel si la calculatrice est déjà présente. J'ai tenté ceci sans succès (du reste, je m'y attendais) :
VB:
Private Sub Bouton_Calculatrice_Click()
'CommandButton permettant d'afficher la calculatrice

Application.ScreenUpdating = False

Dim x

    If Not x Is Nothing Then Exit Sub
    x = Shell("C:\Windows\System32\calc.exe", 1)
      
Range("C2500").Select: Application.ScreenUpdating = True

End Sub
Comment s'y prendre ?
 
Dernière édition:
Solution
Bonsoir,

J'ai trouvé ça. C'est simple et, ma foi, ça marche bien pour la calculatrice.
VB:
Function IsProcessRunning(process As String) As Boolean
'********************************************************************************************
'Vérifie si une application est ouverte
'https://stackoverflow.com/questions/29807691/determine-if-application-is-running-with-excel
'********************************************************************************************
'- process : le nom de l'application (ex : "calc.exe" --> calculatrice Windows)

    Dim objList As Object
   
    Set objList = GetObject("winmgmts:") _
        .ExecQuery("select * from win32_process where name='" & process & "'")
   
    IsProcessRunning = objList.Count > 0...

Magic_Doctor

XLDnaute Barbatruc
Bonjour patricktoulon,

Nos posts se sont croisés, je n'avais pas réfraîchi l'écran.

Ça marche bien, à un détail capilotracté près.

Je clique sur le CommandButton --> la calculatrice apparaît.
Je clique n'importe où sur la feuille, ou je reclique sur le CommandButton --> la calculatrice se réduit (barre des tâches).
Je veux faire réapparaître sur l'écran la calculatrice, il faut alors cliquer 2 fois sur le CommandButton (ou bien la chercher dans la barre des tâches).
À part ce détail, finies les 36 calculatrices qui pouvaient s'accumuler. Ce problème mineur pourrait-il se résoudre ?

Merci patricktoulon, un grand progrès, sans être coincé avec des histoires de langues dans un domaine où l'on ne devrait parler qu'anglais. Fallait pas avoir perdu Waterloo !
 
Dernière édition:

Magic_Doctor

XLDnaute Barbatruc
Désolé, mais chez moi voilà ce qui se passe exactement : quand je clique sur le CommandButton la calculatrice (je précise, qui n'était pas encore ouverte) apparaît ; je reclique sur le CommandButton (ou ailleurs), elle se réduit (il n'y a qu'une seule calculatrice dans la barre des tâches). Je veux la faire réapparaître, il faut alors cliquer 2 fois sur le CommandButton.
 

Dudu2

XLDnaute Barbatruc
Un méthode plus douce qui ne tue personne et permet éventuellement de reprendre les calculs.
VB:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Boolean
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Sub Test()
    Dim hwnd As Long
 
    hwnd = FindWindow(vbNullString, "Calculatrice")
 
    If hwnd Then
        SetForegroundWindow hwnd
        ShowWindow hwnd, 9
    Else
        Shell "C:\Windows\System32\calc.exe", 1
    End If
End Sub
 

Magic_Doctor

XLDnaute Barbatruc
Bonjour à tous,

Effectivement, on clique une fois, puis deux fois... Pfff... pas très pratique tout ça ! Même si, au fond, ce ne sont que des détails.

J'espère, cette fois, avoir réglé définitivement le problème.
Je reprends la solution de Dranreb, la plus simple mais qui ne pèche que pour AppActivate "Calculatrice".
J'ai trouvé une fonction qui permet de détecter la langue de la bécane :
VB:
Function LangueSysteme() As String
'Détecte la langue de l'utilisateur
'par: https://excel-malin.com

On Error GoTo FunctionErreur
Dim CodeLangueSysteme As Single

    'Trouver le code de la langue
    CodeLangueSysteme = Application.LanguageSettings.LanguageID(msoLanguageIDUI)
    
    'Associer le code à la langue (liste complète)
    Select Case CodeLangueSysteme
        Case 1036, 2060, 11276, 3084, 9228, 12300, 15372, 5132, 13324, 6156, 14348, 58380, 8204, 10252, 4108, 7180: LangueSysteme = "Français"
        Case 1033, 2057, 3081, 10249, 4105, 9225, 15369, 16393, 14345, 6153, 8201, 17417, 5129, 13321, 18441, 7177, 11273, 12297: LangueSysteme = "Anglais"
        Case 1031, 3079, 5127, 4103, 2055: LangueSysteme = "Allemand"
        Case 2052, 4100, 1028, 3076, 5124: LangueSysteme = "Chinois"
        Case 1043, 2067: LangueSysteme = "Néerlandais"
        Case 1040, 2064: LangueSysteme = "Italien"
        Case 3082, 1034, 11274, 16394, 13322, 9226, 5130, 7178, 12298, 17418, 4106, 18442, 22538, 2058, 19466, 6154, 15370, 10250, 20490, 21514, 14346, 8202: LangueSysteme = "Espagnol"
        Case 1025, 5121, 15361, 3073, 2049, 11265, 13313, 12289, 4097, 6145, 8193, 16385, 10241, 7169, 14337, 9217: LangueSysteme = "Arabe"
        Case 1078: LangueSysteme = "Afrikaans"
        Case 1052: LangueSysteme = "Albanian"
        Case 1156: LangueSysteme = "Alsatian"
        Case 1118: LangueSysteme = "Amharic"
        Case 1067: LangueSysteme = "Armenian"
        Case 1101: LangueSysteme = "Assamese"
        Case 2092: LangueSysteme = "Azeri (Cyrillic)"
        Case 1068: LangueSysteme = "Azeri (Latin)"
        Case 1133: LangueSysteme = "Bashkir"
        Case 1069: LangueSysteme = "Basque"
        Case 1059: LangueSysteme = "Belarusian"
        Case 1093: LangueSysteme = "Bengali (India)"
        Case 2117: LangueSysteme = "Bengali (Bangladesh)"
        Case 5146: LangueSysteme = "Bosnian (Bosnia/Herzegovina)"
        Case 1150: LangueSysteme = "Breton"
        Case 1026: LangueSysteme = "Bulgare"
        Case 1109: LangueSysteme = "Burmese"
        Case 1027: LangueSysteme = "Catalan"
        Case 1116: LangueSysteme = "Cherokee"
        Case 1155: LangueSysteme = "Corsican"
        Case 1050: LangueSysteme = "Croatian"
        Case 4122: LangueSysteme = "Croatian (Bosnia/Herzegovina)"
        Case 1029: LangueSysteme = "Tchèque"
        Case 1030: LangueSysteme = "Danois"
        Case 1164: LangueSysteme = "Dari"
        Case 1125: LangueSysteme = "Divehi"
        Case 1126: LangueSysteme = "Edo"
        Case 1061: LangueSysteme = "Estonian"
        Case 1080: LangueSysteme = "Faroese"
        Case 1065: LangueSysteme = "Farsi"
        Case 1124: LangueSysteme = "Filipino"
        Case 1035: LangueSysteme = "Finnish"
        Case 1122: LangueSysteme = "Frisian"
        Case 1127: LangueSysteme = "Fulfulde"
        Case 1071: LangueSysteme = "FYRO Macedonian"
        Case 1110: LangueSysteme = "Galician"
        Case 1079: LangueSysteme = "Georgian"
        Case 1032: LangueSysteme = "Greek"
        Case 1135: LangueSysteme = "Greenlandic"
        Case 1140: LangueSysteme = "Guarani"
        Case 1095: LangueSysteme = "Gujarati"
        Case 1128: LangueSysteme = "Hausa"
        Case 1141: LangueSysteme = "Hawaiian"
        Case 1037: LangueSysteme = "Hebrew"
        Case 1081: LangueSysteme = "Hindi"
        Case 1038: LangueSysteme = "Hungarian"
        Case 1129: LangueSysteme = "Ibibio"
        Case 1039: LangueSysteme = "Icelandic"
        Case 1136: LangueSysteme = "Igbo"
        Case 1057: LangueSysteme = "Indonesian"
        Case 1117: LangueSysteme = "Inuktitut"
        Case 2108: LangueSysteme = "Irish"
        Case 1041: LangueSysteme = "Japanese"
        Case 1158: LangueSysteme = "K'iche"
        Case 1099: LangueSysteme = "Kannada"
        Case 1137: LangueSysteme = "Kanuri"
        Case 2144: LangueSysteme = "Kashmiri"
        Case 1120: LangueSysteme = "Kashmiri (Arabic)"
        Case 1087: LangueSysteme = "Kazakh"
        Case 1107: LangueSysteme = "Khmer"
        Case 1159: LangueSysteme = "Kinyarwanda"
        Case 1111: LangueSysteme = "Konkani"
        Case 1042: LangueSysteme = "Korean"
        Case 1088: LangueSysteme = "Kyrgyz (Cyrillic)"
        Case 1108: LangueSysteme = "Lao"
        Case 1142: LangueSysteme = "Latin"
        Case 1062: LangueSysteme = "Latvian"
        Case 1063: LangueSysteme = "Lithuanian"
        Case 1134: LangueSysteme = "Luxembourgish"
        Case 1086, 2110: LangueSysteme = "Malay"
        Case 1100: LangueSysteme = "Malayalam"
        Case 1082: LangueSysteme = "Maltese"
        Case 1112: LangueSysteme = "Manipuri"
        Case 1153: LangueSysteme = "Maori"
        Case 1146: LangueSysteme = "Mapudungun"
        Case 1102: LangueSysteme = "Marathi"
        Case 1148: LangueSysteme = "Mohawk"
        Case 1104: LangueSysteme = "Mongolian (Cyrillic)"
        Case 2128: LangueSysteme = "Mongolian (Mongolian)"
        Case 1121, 2145: LangueSysteme = "Nepali"
        Case 1044: LangueSysteme = "Norwegian (Bokmål)"
        Case 2068: LangueSysteme = "Norwegian (Nynorsk)"
        Case 1154: LangueSysteme = "Occitan"
        Case 1096: LangueSysteme = "Oriya"
        Case 1138: LangueSysteme = "Oromo"
        Case 1145: LangueSysteme = "Papiamentu"
        Case 1123: LangueSysteme = "Pashto"
        Case 1045: LangueSysteme = "Polish"
        Case 1046, 2070: LangueSysteme = "Portuguese"
        Case 1094: LangueSysteme = "Punjabi"
        Case 2118: LangueSysteme = "Punjabi (Pakistan)"
        Case 1131, 2155, 3179: LangueSysteme = "Quechua"
        Case 1047: LangueSysteme = "Rhaeto"
        Case 1048, 2072: LangueSysteme = "Romanian"
        Case 1049, 2073: LangueSysteme = "Russian"
        Case 1083: LangueSysteme = "Sami (Lappish)"
        Case 1103: LangueSysteme = "Sanskrit"
        Case 1084: LangueSysteme = "Scottish Gaelic"
        Case 1132: LangueSysteme = "Sepedi"
        Case 3098: LangueSysteme = "Serbian (Cyrillic)"
        Case 2074: LangueSysteme = "Serbian (Latin)"
        Case 1113, 2137: LangueSysteme = "Sindhi"
        Case 1115: LangueSysteme = "Sinhalese"
        Case 1051: LangueSysteme = "Slovak"
        Case 1060: LangueSysteme = "Slovenian"
        Case 1143: LangueSysteme = "Somali"
        Case 1070: LangueSysteme = "Sorbian"
        Case 1072: LangueSysteme = "Sutu"
        Case 1089: LangueSysteme = "Swahili"
        Case 1053, 2077: LangueSysteme = "Suédois"
        Case 1114: LangueSysteme = "Syriac"
        Case 1064: LangueSysteme = "Tajik"
        Case 1119: LangueSysteme = "Tamazight (Arabic)"
        Case 2143: LangueSysteme = "Tamazight (Latin)"
        Case 1097: LangueSysteme = "Tamil"
        Case 1092: LangueSysteme = "Tatar"
        Case 1098: LangueSysteme = "Telugu"
        Case 1054: LangueSysteme = "Thai"
        Case 2129, 1105: LangueSysteme = "Tibetan"
        Case 2163, 1139: LangueSysteme = "Tigrigna"
        Case 1073: LangueSysteme = "Tsonga"
        Case 1074: LangueSysteme = "Tswana"
        Case 1055: LangueSysteme = "Turkish"
        Case 1090: LangueSysteme = "Turkmen"
        Case 1152: LangueSysteme = "Uighur"
        Case 1058: LangueSysteme = "Ukrainian"
        Case 1056, 2080: LangueSysteme = "Urdu"
        Case 2115: LangueSysteme = "Uzbek (Cyrillic)"
        Case 1091: LangueSysteme = "Uzbek (Latin)"
        Case 1075: LangueSysteme = "Venda"
        Case 1066: LangueSysteme = "Vietnamese"
        Case 1106: LangueSysteme = "Welsh"
        Case 1160: LangueSysteme = "Wolof"
        Case 1076: LangueSysteme = "Xhosa"
        Case 1157: LangueSysteme = "Yakut"
        Case 1144: LangueSysteme = "Yi"
        Case 1085: LangueSysteme = "Yiddish"
        Case 1130: LangueSysteme = "Yoruba"
        Case 1077: LangueSysteme = "Zulu"
        Case 1279: LangueSysteme = "HID (Human Interface Device)"
        
        Case Else: LangueSysteme = ""
    End Select
    
    Exit Function

FunctionErreur:
LangueSysteme = ""

End Function
Et je n'ai plus qu'à écrire :
VB:
Private Sub Bouton_Calculatrice_Click()
'CommandButton permettant d'afficher intelligemment la calculatrice
'Dranreb / Magic_Doctor

Dim langue$

    langue = LangueSysteme
    
    On Error Resume Next
    Select Case langue
        Case "Anglais": AppActivate "Calculator"
        Case "Français": AppActivate "Calculatrice"
        Case "Espagnol", "Guarani", "Portuguese": AppActivate "Calculadora"
        Case "Quechua": AppActivate "Tupuq" 'à vérifier...
        Case "Italien": AppActivate "Calcolatrice"
        Case "Allemand": AppActivate "Taschenrechner"
    End Select
    If Err Then Shell "C:\Windows\System32\calc.exe", 1

End Sub
Et maintenant il n'y a plus qu'à tester. Mais il n'y aurait, je pense, aucune raison que ça ne marche pas.
 

Dudu2

XLDnaute Barbatruc
Cette solution fonctionne mais quand on minimise la calculatrice manuellement, le bouton l'active dans la barre des tâches mais ne l'affiche pas.

Tu n'as pas essayé la solution du message #23 pour laquelle j'ai un peu bataillé avec l'API Windows pour faire revenir cette fenêtre en premier plan dans tous les cas. Mais ça n'a pas d'importance.

Si besoin je peux aussi te faire aussi une fonction qui retourne le(s) nom(s) des fenêtres à partir du nom d'un Process (ex. calc.exe) pour traiter le problème de langue.
 

Dudu2

XLDnaute Barbatruc
1593937033034.gif
les codeurs,
Devant l'enthousiasme suscité par ma proposition
1593936866557.gif
et à la demande générale, voici enfin la tant attendue fonction
1593936997162.gif
qui donne le nom de la (des) fenêtre(s) en fonction d'un processus donné (par exemple calc.exe).
 

Pièces jointes

  • GetWindowNamesFromProcessName.xlsm
    24.6 KB · Affichages: 12
Dernière édition:

Dudu2

XLDnaute Barbatruc
Et, puisque la fonction retourne aussi le Handle, on n'a même plus besoin du nom de la fenêtre !
VB:
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Boolean
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Sub AfficherCalculatrice()
    Dim hwnd As Long
    Const CalculatriceProcessName = "calc.exe"
    Dim Résultat As Variant

    Résultat = GetWindowNamesFromProcessName(CalculatriceProcessName)
  
    If VarType(Résultat) = vbBoolean Then
        Shell "C:\Windows\System32\" & CalculatriceProcessName, 1
    Else
        SetForegroundWindow Résultat(1, 2)
        ShowWindow Résultat(1, 2), 9
    End If
End Sub
 

Pièces jointes

  • AfficherCalculatrice.xlsm
    25.5 KB · Affichages: 13
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
bonjour dudu2
tiens test cela et regarde les surprises ;)
VB:
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal uCmd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hwnd As Long, ByRef lpdwProcessId As Long) As Long
'Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Integer) As Long
'Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal nMaxCount As Integer) As Integer
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Boolean
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Function getProcessId(x$)
    For Each process In GetObject("winmgmts:").ExecQuery("Select * from Win32_Process")
        If process.Caption = x Then getProcessId = process.processId
    Next
End Function

Function GetHandleWindowByProcessId(pr, handle)
    Dim hwnd&, t&, processId&
    hwnd = GetWindow(GetDesktopWindow(), 5)
    Do While Not hwnd = 0
        t = t + 1
        GetWindowThreadProcessId hwnd, processId
        If processId = pr Then GetHandleWindowByProcessId = processId: handle = hwnd: MsgBox t & " tours de boucle: handle trouvé": Exit Do
        hwnd = GetWindow(hwnd, 2)
    Loop
End Function

Sub test()
    Dim pr&, handle&, handleC&
    pr = getProcessId("calc.exe")
    pr2 = GetHandleWindowByProcessId(pr, handle)    ' handle est en callback ( envoyé vide et sera utilisé ensuite )
    handleC = FindWindow(vbNullString, "Calculatrice")

    texte = "par WMI le prossessId est :" & pr & vbCrLf
    texte = texte & "par control avec l'api le prossessId est :" & pr2 & vbCrLf
    texte = texte & "par control avec l'api le handle  est :" & handle & vbCrLf
    texte = texte & "avec l'api findwindow le handle  est :" & handleC & vbCrLf

    MsgBox texte
End Sub
 

Dudu2

XLDnaute Barbatruc
Hello Patrick,
En effet c'est assez étrange, pour moi en tous cas.
Et ça l'est d'autant plus que si tu retires l'Exit Do, tu vas en trouver 5 ou 6 autres qui matchent dont l'un d'entre eux correspondra à celui trouvé par le FindWindow.
Reste à savoir s'ils sont tous utilisables pour porter la Window en foreground et l'afficher ? A tester !
 

patricktoulon

XLDnaute Barbatruc
d'ou ma reflexion sur le match du hwnd pa rapport au prodessId qui peut contenir plusieurs instances en fait
et donc pour moi n'est pas une méthode sur a 100%
;) ;)

ca fait rien tu semble t'amuser avec les api

la seule méthode valable selon moi c'es
le taskkill de calc.exe et une new shell sur calc.exe
cela dit j'ai remarqué une différence avec 2007/2013
le bouton prend le focus et la macro n'a plus d'effet sur le 2d appui avec 2013
sur 2007 pas de soucis
 

Discussions similaires

Statistiques des forums

Discussions
311 709
Messages
2 081 774
Membres
101 816
dernier inscrit
Jfrcs