Fermer une fenêtre selon mot clé dans son titre

Commenter

Contenu du snippet

Ce code permet de fermer des fenêtres ouvertes ou réduites, selon un mot présent dans leur titre.
Exemple: une macro doit RENOMMER UN REPERTOIRE, mais il est ouvert sur plusieurs niveaux dans une fenêtre de l'explorateur Windows... Ce code va permettre de fermer sa fenêtre, et donc à la macro de dérouler normalement.

Source / Exemple : 


'**************************************************
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
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 Vcol = 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
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
'**************************************************

Sub CloseWindow(ZzDir)
Dim hWnd As Long
hWnd = FindWindow(vbNullString, ZzDir)
If hWnd > 0 Then
    Call PostMessage(hWnd, WM_CLOSE, 0, 0)
End If
End Sub
'**************************************************

Conclusion :


La plage de travail (masquée ou non) et le nombre de mots-clé sont à adapter à votre projet
C'est ma première source... merci aux "experts" pour tout commentaire ou amélioration.

A voir également

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 (CerberusPau)