Posez votre question Signaler

[déplacé VB.NET -> VBA] Détecter si l'explorateur Windows a déja été ouvert en V [Résolu]

Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
 - - Dernière réponse : CerberusPau
Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
 - 26 mars 2010 à 19:22
Visual Basic 6 Posez votre question Signaler
Bonjour à tous,

Je veux détecter si l'explorateur Windows a déja été ouvert, pour inviter à le fermer avant de lancer mon application Excel2003 : une macro VBA doit renommer certains répertoires qui pourraient par ailleurs être déjà ouverts au par avant...
J'ai fouillé longuement le forum et j'ai fini par trouver cet ancien mais excellent post de PcPunch, mais qui malheureusement ne me convient pas tout à fait, puisqu'il fait remonter le NOM des fenêtres ouvertes, mais PAS le nom de leur exe ("Explorer.exe" dans mon cas)

http://www.vbfrance.com/forum/sujet-DETECTION-OUVERTURE-FERMETURE-NOUVELLES-FENETRE_213569.aspx#9

Comment exploiter les API EnumWindows et IsWindowVisible pour récupérer l'EXE et non plus le nom de la fenêtre (GetWindowText)

En espérant avoir été assez clair, et pardonné d'être un peu long!

Merci d'avance
Afficher la suite 

5 réponses

Meilleure réponse
Signaler Commenter la réponse de CerberusPau
Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
3
Merci
Arghhhhh!!
1°) Et si les cellules de destinantion (AA1, AB1,AC1,etc. dans mon exemple) ne sont pas vides au lancement de Sub CloseWindowsOpened() ???
2°) Et si on veut pouvoir masquer/démasquer les colonnes avant et après dans Sub CloseWindowsOpened() ????

Adapter le code dans CloseWindowsOpened
modifications entre '=====> et '=====< 

Sub CloseWindowsOpened()                    'SUB PRINCIPALE A LANCER
Worksheets(1).Unprotect (VBpassword)        'protection désactivée
Worksheets(1).Select
Set S = ActiveSheet                         ' PAS de .Select !!

'=====> Afficher des colonnes masquées
S.Columns("L:IV").Hidden = False            'affiche les colonnes L à IV
Range("IV1").End(xlToLeft).Select           '.Select (!) la cellule en dernière colonne non vide en ligbe 1
'=====> Vider les celllules de destination au préalable
EndCol = ActiveCell.Column + 1              'récupérer le N° de la dernière colonne depuis la première affichée (A)
Vcol = 27
For Vcol = 27 To EndCol                     'Pour w= N° de la dernère colonne en ligne 1...
    S.Cells(1, Vcol).Activate               'cellule active
    NmVCol = Left(ActiveCell.Address(0, 0), (ActiveCell.Column < 27) + 2) 'donne le NOM de la colonne
    If Range("" & NmVCol & "1").Value = "" Then Exit For 'si la cellule est vide, on sort du For
    ZzDir = Range("" & NmVCol & "1").Value   'c'est le nom de la fenêtre analysée à chaque boucle
    If ZzDir <> "" Then Range("" & NmVCol & "1").Value = "" 'vidage de la cellule
Next Vcol
'=====<
App_Ouverte                                 'appelle la fonction
S.Range("AA1").TextToColumns Destination:=Range("AA1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="£", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), _
        TrailingMinusNumbers:=True 'Conversion par le signe £ (chaque texte est dans une cellule de la ligne 1 à partir de AA1
'Attention : AUCUNE colonne cachée...
Range("IV1").End(xlToLeft).Select           '.Select (!) la cellule en dernière colonne non vide en ligbe 1
NbCol = ActiveCell.Column + 1               'récupérer le N° de la dernière colonne depuis la première affichée (A)
'Dim w
ZzDir = ""
w = 27                                      'on démarre la boucle depuis AA1 (colonne 27)
For w = 27 To NbCol                         'Pour w= N° de la dernère colonne en ligne 1...
    S.Cells(1, w).Activate                  'cellule active
    NmCol = Left(ActiveCell.Address(0, 0), (ActiveCell.Column < 27) + 2) 'donne le NOM de la colonne
    If Range("" & NmCol & "1").Value = "" Then Exit For 'si la cellule est vide, on sort du For
    ZzDir = Range("" & NmCol & "1").Value   'c'est le nom de la fenêtre analysé à chaque boucle
    Set W1 = Range("" & NmCol & "1").Find("UsedProg")       'en W1 : le mot UsedProg
    Set W2 = Range("" & NmCol & "1").Find("SaveOutLS")      'En W2 : le mot SaveOutLS
    Set W3 = Range("" & NmCol & "1").Find("SaveProg_Tech")  'En W3 : le mot SaveProg_Tech
    Set W4 = Range("" & NmCol & "1").Find("BackProg")       'En W4 : le mot BackProg
    Set W5 = Range("" & NmCol & "1").Find("ZipProg")        'En W5 : le mot ZipProg
    If Not W1 Is Nothing Then
        CloseWindow (ZzDir)                     'toutes les fenêtres contenant le mot en W1 sont fermées
    ElseIf Not W2 Is Nothing Then
        CloseWindow (ZzDir)                     'toutes les fenêtres contenant le mot en W2 sont fermées
    ElseIf Not W3 Is Nothing Then
        CloseWindow (ZzDir)                     'toutes les fenêtres contenant le mot en W3 sont fermées
    ElseIf Not W4 Is Nothing Then
        CloseWindow (ZzDir)                     'toutes les fenêtres contenant le mot en W4 sont fermées
    ElseIf Not W5 Is Nothing Then
        CloseWindow (ZzDir)                     'toutes les fenêtres contenant le mot en W5 ont fermées
    End If                                      'les Set W,  et les If Not sont à adapter...!
    Range("" & NmCol & "1").Value = ""          'Vidage de la cellule analysée
Next w                                          'reprise de la boucle

'=====> Masque des colonnes
S.Columns("L:IV").Hidden = True                                                   'masque les colonnes L à IV
'=====<

Range("A1").Select
Worksheets(1).Protect PassWord:=VBpassword, DrawingObjects:=False, Contents:=True, Scenarios:=True, AllowFiltering:=True ' reverrouillage VB
End Sub
'**************************************************



Rataxes64

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 135 internautes nous ont dit merci ce mois-ci

Commenter la réponse de CerberusPau
Signaler Commenter la réponse de CerberusPau
Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
0
Merci
Bonjour à tous,

A force de chercher, je crois que je n'ai pas d'autre choix que de travailler sur le nom exact de chacune des fenêtres ouvertes.
Pour cela il faut que j'en extraie la liste dans un tableau (par exemple un fichier TXT que je collerai dans une feuille Excel).
Ensuite, chaque nom de fenêtre dont le chemin contient le nom d'un répertoire à fermer, est repris dans la macro de fermeture par succesion de IF.
Mais je tourne rond pour "sortir" cette liste en fichier TXT par la macro proposée par PcPunch qui, elle, affiche une MsgBox.
Voici le code que je cherche à adapter:

**************************************
'Dans un même module
**************************************
Dim Temp As String
Private Declare Function IsWindowVisible Lib "user32" (ByVal HWnd As Long) As Long
Declare Function EnumWindows Lib "user32" ( _
ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Boolean

Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
ByVal HWnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long

Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" _
(ByVal HWnd As Long) As Long
**************************************
[b]Sub WindowsOpened()
'MsgBox App_Ouverte 'reprendre en Txt?
'Shell ("notepad.exe, C:\WindowsList.txt"), App_Ouverte 'mauvaise syntaxe!
End Sub/b
**************************************
Public Function EnumWindowsProc(ByVal HWnd As Long, ByVal lParam As Long) As Boolean
Dim sSave As String, Ret As Long
ouverte = "" 'Split(App_Ouverte, vbCrLf)
Ret = GetWindowTextLength(HWnd)
sSave = Space(Ret)
GetWindowText HWnd, sSave, Ret + 1
If sSave <> vbNullString And IsWindowVisible(HWnd) Then Temp = Temp & sSave & vbCrLf
'continue enumeration
EnumWindowsProc = True
End Function
*************************************
Public Function App_Ouverte()
EnumWindows AddressOf EnumWindowsProc, ByVal 0&
App_Ouverte = Temp
End Function
*************************************

Je n'ai pas su exploiter le code complémentaire ci-dessous...

*************************************
Sub Tableau()
Dim Tableau() As String
Tableau = Split(App_Ouverte, vbCrLf)
For i = 0 To UBound(Tableau)
List1.AddItem Tableau(i) 'affichage dans un listbox
Next i
End Sub
*************************************

Merci pour toute aide
Rataxes64
Commenter la réponse de CerberusPau
Signaler Commenter la réponse de CerberusPau
Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
0
Merci
Ben voilà
A force de chercher on trouve...
Mais il y a certainement plus simple !

Je passe par une feuille Excel
1°) Je copie la liste d'extraction des noms des fenêtres séparées par £ dans la cellule AA1
2°) Je la convertie grâce à £ (en AA1, AB1,AC1, etc...)
3°) Je cherche la valeur de la colonne finale en ligne 1 (elle est numérique!)
4°) Dans un tableau de conversion, j'extraie le NOM de la dernière colonne par RECHERCHEV d'une plage : colonne des valeurs numériques en regard des Noms (exemple le N° de colonne 32 donne AF)
5°)Dans la macro, je SET les mots clés qui seront présents dans le nom des fenêtres ouvertes que je veux fermer.
6°) Les plages de travail sont vidées en fin de macro

RESULTAT : toutes les fenêtres dont le nom contient un mot clé sont fermées

En espérant que cela servira à quelques uns d'entre vous (je n'ai pas la prétention de faire un "code source" en l'état!), et qu'on pourra peut-être m'indiquer quelquechose de plus simple...

Cdt

Code (dans un même module):
'**************************************************
Public Const WM_CLOSE = &H10
Public Const WM_NCDESTROY = &H82
'**************************************************
Public Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" ( _
ByVal HWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Public Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
'**************************************************
Private Declare Function IsWindowVisible Lib "user32" (ByVal HWnd As Long) As Long
'**************************************************
Declare Function EnumWindows Lib "user32" ( _
ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Boolean
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
ByVal HWnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" _
(ByVal HWnd As Long) As Long
'**************************************************
Dim Temp As String
'**************************************************


'**************************************************
Public Function EnumWindowsProc(ByVal HWnd As Long, ByVal lParam As Long) As Boolean
Dim sSave As String, Ret As Long
ouverte = "" 'Split(App_Ouverte, vbCrLf)
Ret = GetWindowTextLength(HWnd)
sSave = Space(Ret)
GetWindowText HWnd, sSave, Ret + 1
If sSave <> vbNullString And IsWindowVisible(HWnd) Then Temp = Temp & sSave & "£" 'vbCrLf
EnumWindowsProc = True
End Function
'**************************************************


'**************************************************
Public Function App_Ouverte()
Worksheets(1).Unprotect (VBpassword)
EnumWindows AddressOf EnumWindowsProc, ByVal 0&
Range("AA1").Value = Temp
App_Ouverte = Temp
Temp = "" 'reset les infos dans Temp
End Function
'**************************************************


'**************************************************
Sub WindowsOpened()
App_Ouverte

Range("AA1").Select
Selection.TextToColumns Destination: =Range("AA1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="£", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), _
TrailingMinusNumbers:=True

Range("IV1").End(xlToLeft).Select
NbCol = ActiveCell.Column
Range("AA2").Value = NbCol
Col = Range("AB2").Value '=RECHERCHEV(AA2;AA3:AB27;2;FAUX)
Range("AA1:" & Col & "1").Select
Selection.Cut
Selection.Copy
Range("Z1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=True

Dim w
Dim c As Object
w = 1
For w = 1 To NbCol - 26
If Range("Z" & w).Value = "" Then Exit For
ZzDir = Range("Z" & w & "").Value
Set W1 = Range("Z" & w).Find("UsedProg")
Set W2 = Range("Z" & w).Find("SaveOutLS")
Set W3 = Range("Z" & w).Find("SaveProg_Tech")
Set W4 = Range("Z" & w).Find("BackProg")
If Not W1 Is Nothing Then
CloseWindow (ZzDir)
ElseIf Not W2 Is Nothing Then
CloseWindow (ZzDir)
ElseIf Not W3 Is Nothing Then
CloseWindow (ZzDir)
ElseIf Not W4 Is Nothing Then
CloseWindow (ZzDir)
End If
Next w
Range("AA2").Value = ""
Range("AA1:" & Col & "1").Select
Selection.ClearContents
Range("Z1:Z" & NbCol - 26).Select
Selection.ClearContents
End Sub
'**************************************************


'**************************************************
Sub CloseWindow(ZzDir)
Dim HWnd As Long
HWnd = FindWindow(vbNullString, ZzDir)
If HWnd > 0 Then
SendMessage HWnd, WM_NCDESTROY, 0, 0
End If
End Sub
'**************************************************


Rataxes64
Commenter la réponse de CerberusPau
Signaler Commenter la réponse de CerberusPau
Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
0
Merci
Bonjour,
N'y a-t'il vraiemnt pas plus simple SVP ?
Merci


Rataxes64
Commenter la réponse de CerberusPau
Signaler Commenter la réponse de CerberusPau
Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
0
Merci
Salut,
J'ai eu des soucis avec .Select et SendMessage.

Voila un code un peu plus élégant et surtout plus fiable : pas d'appel à .Select et on passe par CallMessage 
'**************************************************
Public Const WM_CLOSE = &H10                'message
Public Const WM_NCDESTROY = &H82            'message
'**************************************************
Public Declare Function FindWindow Lib "user32" _
    Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long   'fonction FindWindow
'**************************************************
Private Declare Function IsWindowVisible Lib "user32" ( _
    ByVal hWnd As Long) As Long             'affichage reconnu
Private Declare Function PostMessage Lib "user32" _
    Alias "PostMessageA" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long           'envoyer messages
'**************************************************
Declare Function EnumWindows Lib "user32" ( _
    ByVal lpEnumFunc As Long, _
    ByVal lParam As Long) As Boolean        'décomptage
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
    ByVal hWnd As Long, _
    ByVal lpString As String, _
    ByVal cch As Long) As Long              'récupérer le texte
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" _
    (ByVal hWnd As Long) As Long            'récupérer la taille du texte
'**************************************************
Dim Temp As String                          'tampon
'**************************************************

Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean 'Proc
Dim sSave As String, Ret As Long
ouverte = ""                                'élaboration des textes de fenêtres
Ret = GetWindowTextLength(hWnd)             'séparés du caractère  £ pour pouvoir
sSave = Space(Ret)                          'les extraire et les analyser ensuite
GetWindowText hWnd, sSave, Ret + 1
If sSave <> vbNullString And IsWindowVisible(hWnd) Then Temp = Temp & sSave & "£"
EnumWindowsProc = True
End Function
'**************************************************

Public Function App_Ouverte()
Worksheets(1).Unprotect (VBpassword)        'déprotection de la feuille en VB (si besoin)
EnumWindows AddressOf EnumWindowsProc, ByVal 0&     'attribution de la Proc
Worksheets(1).Range("AA1").Value = ""       'vidage de la Cellule de récupération générale AA1
Worksheets(1).Range("AA1").Value = Temp     'Valeur des tous les textes trouvés sur une seule ligne en AA1
App_Ouverte = Temp                          'reprise du tampon
Temp = ""                                   'reset les infos dans le tampon
End Function
'**************************************************

Sub CloseWindowsOpened()                    'SUB PRINCIPALE A LANCER
App_Ouverte                                 'appelle la fonction
Set S = ActiveSheet                         ' PAS de .Select !!
S.Range("AA1").TextToColumns Destination:=Range("AA1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="£", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), _
        TrailingMinusNumbers:=True 'Conversion par le signe £ (chaque texte est dans une cellule de la ligne 1 à partir de AA1
'Attention : AUCUNE colonne cachée...
Range("IV1").End(xlToLeft).Select           '.Select (!) la cellule en dernière colonne non vide en ligbe 1
NbCol = ActiveCell.Column + 1               'récupérer le N° de la dernière colonne depuis la première affichée (A)
Dim w
ZzDir = ""
w = 27                                      'on démarre la boucle depuis AA1 (colonne 27)
For w = 27 To NbCol                         'Pour w= N° de la dernère colonne en ligne 1...
    S.Cells(1, w).Activate                  'cellule active
    NmCol = Left(ActiveCell.Address(0, 0), (ActiveCell.Column < 27) + 2) 'donne le NOM de la colonne
    If Range("" & NmCol & "1").Value = "" Then Exit For 'si la cellule est vide, on sort du For
    ZzDir = Range("" & NmCol & "1").Value   'c'est le nom de la fenêtre analysé à chaque boucle
    Set W1 = Range("" & NmCol & "1").Find("UsedProg")       'en W1 : le mot UsedProg
    Set W2 = Range("" & NmCol & "1").Find("SaveOutLS")      'En W2 : le mot SaveOutLS
    Set W3 = Range("" & NmCol & "1").Find("SaveProg_Tech")  'En W3 : le mot SaveProg_Tech
    Set W4 = Range("" & NmCol & "1").Find("BackProg")       'En W4 : le mot BackProg
    Set W5 = Range("" & NmCol & "1").Find("ZipProg")        'En W5 : le mot ZipProg
    If Not W1 Is Nothing Then
        CloseWindow (ZzDir)                     'toutes les fenêtres contenant le mot en W1 sont fermées
    ElseIf Not W2 Is Nothing Then
        CloseWindow (ZzDir)                     'toutes les fenêtres contenant le mot en W2 sont fermées
    ElseIf Not W3 Is Nothing Then
        CloseWindow (ZzDir)                     'toutes les fenêtres contenant le mot en W3 sont fermées
    ElseIf Not W4 Is Nothing Then
        CloseWindow (ZzDir)                     'toutes les fenêtres contenant le mot en W4 sont fermées
    ElseIf Not W5 Is Nothing Then
        CloseWindow (ZzDir)                     'toutes les fenêtres contenant le mot en W5 ont fermées
    End If                                      'les Set W,  et les If Not sont à adapter...!
    Range("" & NmCol & "1").Value = ""          'Vidage de la cellule analysée
Next w                                          'reprise de la boucle
Worksheets(1).Protect PassWord:=VBpassword, DrawingObjects:=False, Contents:=True, Scenarios:=True, AllowFiltering:=True ' reverrouillage VB
End Sub
'**************************************************


Bon, allez, je remercie le Forum pour tout ce que j'ai pu y trouver, et je vais oser me remercier de mes efforts, qui vont certainement profiter à d'autres.
C'est vrai que j'aurais aimé un peu de compagnie sur ce post... une prochaine fois sûrement.



Rataxes64
Commenter la réponse de CerberusPau
Répondre Posez votre question