Cette source(fichier excel) permet d'arreter une ou plusieurs session excel caché et ce a partir d'une autre session excel. Juste pour le fun car évidemment en l'état cela ne sert pas à grand chose.
Vous trouverez dans ce fichier 3 boutons:
- le premier permet de lancer une session excel caché (utile uniquement pour la demo)
- le deuxieme permet de voire toute les sessions excel en cours
- le troisieme permet d'arreter les sessions cachées d'excel
Noter que cette source est facilement transposable en VB6 car elle utilise en grande partie les API Windows
Source / Exemple :
'Macro Créée par : BigFish_le Vrai (Philippe E)
'le :06-08-2008
'V1.0
'
Option Explicit
'API ouverture processus et ses constantes
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Const PROCESS_VM_READ As Long = (&H10)
Public Const PROCESS_QUERY_INFORMATION As Long = (&H400)
Public Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long
Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetModuleFileNameEx Lib "psapi.dll" Alias "GetModuleFileNameExA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Const PROCESS_TERMINATE As Long = &H1
Public Const MAX_PATH As Integer = 260
Public hProcess As Long 'handle du processus
Public bob As Long, CurrentProcessId As Long, ViewOnly As Boolean
Function EnumWinProc(ByVal lhWnd As Long, ByVal lParam As Long) As Long
'-----------------------------------
'enumeration des processus
'renvoie du/des session(s) excel
'Arret du/des Processus excel caché
'-----------------------------------
Dim RetVal As Long, ProcessID As Long, ThreadID As Long
Dim WinClassBuf As String * 255, WinTitleBuf As String * 255
Dim WinClass As String, WinTitle As String, NomExe As String
' see the Windows Class and Title for each top level Window
RetVal = GetClassName(lhWnd, WinClassBuf, 255)
WinClass = StripNulls$(WinClassBuf) ' remove extra Nulls & spaces
RetVal = GetWindowText(lhWnd, WinTitleBuf, 255)
WinTitle = StripNulls$(WinTitleBuf)
' la fenetre(thread principale)est elle visible ?
RetVal = IsWindowVisible(lhWnd)
' on recupere l'PID de la fenetre(thread principale)
ThreadID = GetWindowThreadProcessId(lhWnd, ProcessID)
' on recupere le nom du thread principale
NomExe = GetProcessFileName(ProcessID)
With Worksheets("sheet1")
If NomExe = "excel.exe" And WinTitle Like "Microsoft Excel*" = True Then
' ecriture des données sur la feuille
.Range("A" & bob).Value = NomExe
.Range("B" & bob).Value = ProcessID
' on converti le resultat binaire en booleen pour une meilleur lecture
.Range("C" & bob).Value = CBool(RetVal * -1)
.Range("D" & bob).Value = WinTitle
' si le processus est le processus courant
' on lui applique une mise en forme specifique
If ProcessID = CurrentProcessId Then
.Range("A" & bob & ":E" & bob).Interior.ColorIndex = 35
.Range("E" & bob).Value = "Current"
End If
' si le thread principale d'excel est invisible
If RetVal = 0 Then
.Range("A" & bob & ":E" & bob).Interior.ColorIndex = 44
If ViewOnly = False Then
' on arrete le processus
' La fonction renvoie 1 si le processus c'est arrete
If CloseProcess(ProcessID) = 1 Then
.Range("E" & bob).Value = "Killed"
Else
MsgBox "le process n'a pas pu etre arreté ! ", vbExclamation
End If
End If
End If
bob = bob + 1
End If
End With
CloseHandle hProcess
EnumWinProc = True
End Function
Public Function StripNulls(OriginalStr As String) As String
' This removes the extra Nulls so String comparisons will work
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function
' ---------------------------------------------
' Renvoie le Nom du processus
' ---------------------------------------------
' Parametre
' ProcessID : ID du processus
' ---------------------------------------------
' d'apres un code de : MadMatt
' Titre d'origine : Renvoie le chemin complet du processus
' Son Site Perso : http://matthieu.napoli.free.fr
' Le site du code : http://vbsystemlibrary.free.fr/code.php?ID=5
' ---------------------------------------------
Public Function GetProcessFileName(ByVal ProcessID As Long) As String
' Processus 0
If ProcessID = 0 Then
GetProcessFileName = "[System Process]"
' Processus 4
ElseIf ProcessID = 4 Then
GetProcessFileName = "System"
Else
' On cherche son chemin d'accès complet
'Dim hProcess As Long 'handle du processus
Dim hModule As Long 'handle du module de l'exe
Dim Ret As Long 'résultat
' On demande un handle pour le processus
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ Or PROCESS_TERMINATE, 0&, ProcessID)
' Si erreur (accès refusé)
If hProcess Then
' On préformate la chaine
GetProcessFileName = Space(MAX_PATH)
' On récupère son nom complet
GetModuleFileNameEx hProcess, 0, GetProcessFileName, MAX_PATH
' On ferme le handle ouvert
'CloseHandle hProcess
' On retire le vbNUllChar de fin de chaine
GetProcessFileName = Left(GetProcessFileName, InStr(GetProcessFileName, vbNullChar) - 1)
'on extrait le nom de l'Image du processus
GetProcessFileName = LCase(Right(GetProcessFileName, InStr(1, StrReverse(GetProcessFileName), "\") - 1))
Exit Function
ElseIf hProcess = 0 Then
GetProcessFileName = vbNullString
End If
End If
End Function
' ---------------------------------------------
' Termine le processus
' ---------------------------------------------
Public Function CloseProcess(ProcessID As Long) As Long
'fermeture du thread principal d'excel
CloseProcess = TerminateProcess(hProcess, 0)
End Function
Conclusion :
Je suis loin d'etre un expert de la programmation a l'aide des API donc ce n'est surement pas parfait.
Toute suggestion est la bien venu.
Merci à MadMatt pour la partie : Renvoie le nom du processus
A+
3ddI7IHd
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.