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