Fermer automatiquement un dossier [Résolu]

bmpailli 11 Messages postés mercredi 29 décembre 2010Date d'inscription 7 mars 2014 Dernière intervention - 29 déc. 2010 à 18:30 - Dernière réponse : bmpailli 11 Messages postés mercredi 29 décembre 2010Date d'inscription 7 mars 2014 Dernière intervention
- 31 déc. 2010 à 16:51
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.
Afficher la suite 

Votre réponse

4 réponses

Meilleure réponse
CerberusPau 376 Messages postés lundi 3 avril 2006Date d'inscription 7 avril 2015 Dernière intervention - 31 déc. 2010 à 13:33
3
Merci
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

Merci CerberusPau 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 83 internautes ce mois-ci

Commenter la réponse de CerberusPau
CerberusPau 376 Messages postés lundi 3 avril 2006Date d'inscription 7 avril 2015 Dernière intervention - 31 déc. 2010 à 00:10
0
Merci
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
Commenter la réponse de CerberusPau
bmpailli 11 Messages postés mercredi 29 décembre 2010Date d'inscription 7 mars 2014 Dernière intervention - 31 déc. 2010 à 09:36
0
Merci
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
Commenter la réponse de bmpailli
bmpailli 11 Messages postés mercredi 29 décembre 2010Date d'inscription 7 mars 2014 Dernière intervention - 31 déc. 2010 à 16:51
0
Merci
Merci merci,

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

Merci encore
Commenter la réponse de bmpailli

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.