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)
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
'**************************************************
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
*************************************
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
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
'**************************************************
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.
