Fermer automatiquement un dossierRésolu

Question

Bonjour,
J'ai créé plusieurs classeurs excel utilisés par des novices dans le maniement informatique. Chaque classeur est doté de macro permettant de sauvegarder et fermer au bout de x minutes. Mais les utilisateurs ne ferment jamais les dossiers contenant les classeurs. Au bout d'une matinée et 15 utilisateures , il y a 15 dossiers ouverts.
Existe-t-il une procédure VBA permettant à la fermeture du classeur de fermer également le dossier le contenant ? Je sais créer un dossier par l'objet Folder, mais pour le fermer, je sèche.
Merci de votre aide.

CerberusPau · Accepted Answer

Salut, Bon, s'agissant de fenêtres, tu trouveras du code (à insérer dans un module) que j'utilise pour une de mes appli. Il faudra l'adapter à ton besoin en modifiant les plages de travail ou cachées en feuil1(AA1 et colonnes L à IV pour moi), et en attribuant une Public Const à VBpassword si tu veux protéger avec un mot de passe. De même pour les NOMS de tes Dossiers : Moi j'en ai besoin de 5 (W1 à W5) mais tu peux en ajouter bien sûr. Je comptais mettre en Source car cette question revient souvent, mais je n'ai pas encore eu le temps de "toiletter" un peu...! Dans un module (P. ex. "CloseWindows") Public Const WM_CLOSE = &H10 '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() '=> Application 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 'Workbooks(VBsource).Activate 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 derniè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("Dossier1") 'en W1 : le Dossier1 Set W2 = Range("" & NmCol & "1").Find("Dossier2") 'En W2 : le Dossier2 Set W3 = Range("" & NmCol & "1").Find("Dossier3") 'En W3 : le Dossier3 Set W4 = Range("" & NmCol & "1").Find("Dossier4") 'En W4 : le Dossier4 Set W5 = Range("" & NmCol & "1").Find("Dossier5") 'En W5 : le Dossier5 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) '=> Commande de fermeture des fenêtres concernées Dim hwnd As Long hwnd = FindWindow(vbNullString, ZzDir) If hwnd > 0 Then Call PostMessage(hwnd, WM_CLOSE, 0, 0) End If End Sub '************************************************** Pour fermer les Dossiers il faut appeler la macro : Sub CloseWindowsOpened() Bon courage, et ... Bonne année! Rataxes64

CerberusPau · Answer

Salut bmpailli,

Je pourrai peut-être t'aider, mais que veux-tu dire exactement par "fermer un Dossier contenant un Classeur" ? S'agit-il d'une fenêtre ? d'un fichier ouvert par lien ? ...


Rataxes64

bmpailli · Answer

Salut,

J'entends par là fermer une fenêtre :

Concrètement, sur le bureau Windows, se trouve un racourci "Gestion", dossier de fichiers contenant notamment les sous-dossiers "Marges" et "MEA". Chacun de ces sous-dossiers contient des classeurs Excel. Cette architecture m'est nécessaire pour des raisons de classement, de recherche, etc...

Les utilisateurs utilisent quotidiennement un où plusieurs classeurs. Ces classeurs sont pourvus de macros gérant leur enregistrement et leur fermeture automatiquement, ainsi que l'ouverture d'une application Olifax, qui doit absolument rester ouverte. Pour une raison qui m'échappe encore, certaines personnes s'évertuent à fermer toutes les applications ouvertes avant d'utiliser celle qui les intéresse.

Mon problème est que 
[*] d'une part très peu de personnes ferment les fenêtres des dossiers "Gestion", "Marges", "MEA", etc, ce qui encombre un petit à petit la barre des tâches (ce qui n'est pas très grave, je reconnais) 
[*] d'autre part les utilisateurs de bonne volonté ferment bien ces fenêtres, mais commencent souvent par fermer l'application Olifax, ce qui est plus génant, car la fermeture de cette application bloque le transfert des fax au PC.

Je cherche donc une méthode (procédure Windows ou VBA) pour fermer, à chaque fermeture automatique d'un fichier Excel, les fenêtres des dossiers et sous-dossiers le contenant.

J'espère que c'est plus clair,
Merci de ton aide

bmpailli · Answer

Merci merci,

Ça m'a l'air assez complexe, je vais m'y plonger et tester,

Merci encore

Fermer automatiquement un dossier

4 réponses

Votre réponse

Discussions similaires