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 '**************************************************
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question'************************************************** 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 '**************************************************