1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources VBA
  5. Tuer une/des session(s) cachée(s) d'excel à partir d'une autre session

Tuer une/des session(s) cachée(s) d'excel à partir d'une autre session

Soyez le premier à donner votre avis sur cette source.

Vue 7 005 fois - Téléchargée 424 fois

Télécharger le projet
Commenter

Description

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
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
cs_aljan
Messages postés
9
Date d'inscription
dimanche 23 mars 2008
Statut
Membre
Dernière intervention
28 octobre 2010
22 nov. 2008 à 18:49
Bonjour,
Un de plus pour confirmer que ça sert! j'ai adapté ce code à une application qui me posait quelques problèmes de nettoyage en cas de fermeture anormale et cela fonctionne très bien.
Merci !
aljan
Chrysostome
Messages postés
121
Date d'inscription
vendredi 17 octobre 2003
Statut
Membre
Dernière intervention
14 octobre 2016
13 oct. 2008 à 11:22
Salut! Juste pour dire que ça sert quand il faut fermer des programmes à des fins de sauvegarde ou de transfert FTP ou ... L'emploi de killers est dangereux et difficilement maîtrisable.
bigfish_le vrai
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
 12
4 sept. 2008 à 18:57
Bonjour á tous,

apparemment certain d'entre vous rencontre un probleme lors de l'ouverture du fichier. Ce probleme provoquerait la fermeture d'excel.

Si vous rencontrez ce probleme merci de m'en fair part ici ou par MP

Amicalement,

3ddI7IHd
Witold
Messages postés
5
Date d'inscription
vendredi 28 mars 2008
Statut
Membre
Dernière intervention
7 août 2008
7 août 2008 à 22:31
Merci d'avoir résolu mon problème
bigfish_le vrai
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
 12
6 août 2008 à 16:55
Salut us_30,

merci pour tes encouragements ^^

Amicalement,

3ddI7IHd
Afficher les 6 commentaires
S'inscrire maintenant

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.

Du même auteur (bigfish_le vrai)