Fermeture automatique d'excel inactif

Soyez le premier à donner votre avis sur cette source.

Snippet vu 17 921 fois - Téléchargée 20 fois

Commenter

Contenu du snippet

Ferme et sauve automatiquement un fichier source Excel (exemple, en réseau et mode non partagé)au bout d'un temps d'inactivité (ici 3mn)

Source / Exemple : 


'Dans le fichier source

'Ajouter dans ThisWorkbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopAutoClose
End Sub

'Ajouter un Module
Option Explicit
Public Tp10, Tp180, WbC As Variant
Private Declare Function APIBeep Lib "kernel32" Alias "Beep" _
         (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
'************************************************************************************

Sub Beeper1()
'=> Fréquence moyenne du Beep

APIBeep 500, 150
End Sub
'************************************************************************************

Sub Beeper2()
'=> Fréquence basse du Beep

APIBeep 200, 150
End Sub
'************************************************************************************

Sub StartTempo()
'=> Lancement de la durée d'accès libre (3 minutes avant alerte de relance)

Tp180 = Now + TimeValue("00:03:00")             'définit la durée de 180 secondes avant de lancer la prodédure de fermeture automatique
Application.OnTime Tp180, "AlerteFin"           'appelle la procédure de fermeture automatique
MemData.Mem1.Value = "1"                        'tempo Tp180 activée
End Sub
'************************************************************************************

Sub AlerteFin()
'=> Message de Relance (Arrêt Automatique engagé dans les 10 secondes)

MemData.Mem1.Value = "0"                        'tempo Tp180 échue
MemData.Mem2.Value = Date                       'initialisation du point de comptage par valeur de date
MemData.Mem3 = "1"                              'tempo Tp10 activée
CountDown                                       'lancement du comptage des 10 dernières secondes
End Sub
'************************************************************************************

Sub CountDown()
'=> Sauvegarde de Fermeture du Classeur dans 10 secondes...

'Application.ScreenUpdating = False
AlerteLS.Show                                   'affichage du temps restant et du bouton de relance
Tp10 = Now + TimeValue("00:00:01")
Dim Tp0, Tp1 As Date                            'format Date
Tp0 = CDate(MemData.Mem2.Value)                 'reprise du temps écoulé
Tp1 = Tp0 + 1                                   'temps restant à courrir = temps écoulé + une seconde
If Tp1 < Date + 11 Then                         'si temps restant à courrir < 11 secondes
    Application.ScreenUpdating = False
    MemData.Mem2.Value = Tp1                    'réinitialisation du temps écoulé
    Application.OnTime Tp10, "CountDown"        'rebouclage après une seconde
    Dim T As Long                               'format Long
    T = ((Date + 10) - Tp0) - 1                 'nombre de secondes restant
    Alerte.Caption = " Fermeture dans " & T & " Secondes"
    
    'Options de l'alerte sonore avant fermeture
    '******************************************
     'Beep décommenté
        '=> Son Windows par défaut pour tout le décompte
     'If > Beeper1 ET If < Beeper2 décommentés
        '=> Son 1, suivi du Son 2 les 3 dernières secondes
    
    Beep                                         'Son Windows : commenter If > Beeper1 ET If < Beeper2
    'If T > 3 Then Beeper1                       'Son Médium : commenter Beep
    'If T < 4 Then Beeper2                       'Son Grave  : commenter Beep

Else                                             'si les 10 secondes sont écoulées
    MemData.Mem2 = "0"                          'RAZ point de comptage
    MemData.Mem3 = "0"                          'CountDown : tempo Tp10 échue
    Alerte.Hide                                 'ferme l'affichage
    Application.DisplayAlerts = False           'inhibe le message d'enregistrement
    WbC = Workbooks.Count                       'compte les classeurs ouverts
    If WbC < 2 Then                             'si aucun classeur ouvert
        Workbooks("nom du fichier source").Save 'enregistre le classeur
        Application.Quit                        'ferme Excel
    Else                                        'si d'autres classeurs ouverts
        Workbooks("Nom du fichier source").Save 'enregistre le classeur
        Workbooks("Nom du fichier source").Close 'ferme seulement le classeur
    End If
End If
End Sub
'************************************************************************************

Sub Relancer()
'=> Arrêt du processus automatique de fermeture et relance

On Error Resume Next
Application.OnTime Tp180, "AlerteFin", , False  'arrêt de AlerteFin : tempo Tp180
Application.OnTime Tp10, "CountDown", , False   'arrêt de CountDown : tempo Tp10
If MemData.Mem3 = "1" Then Alerte.Hide          'ferme l'affichage si tempo Tp10 non échue
MemData.Mem1 = "0"                              'tempo Tp180 échue
MemData.Mem2 = "0"                              'RAZ point de comptage
MemData.Mem3 = "0"                              'CountDown : tempo Tp10 échue
StartTempo                                      'engage la relance
End Sub
'************************************************************************************

Sub StopAutoClose()
'=> Arrêt du processus automatique de fermeture
On Error Resume Next
Application.OnTime Tp180, "AlerteFin", , False  'arrêt de AlerteFin : tempo Tp180
Application.OnTime Tp10, "CountDown", , False   'arrêt de CountDown : tempo Tp10
If MemData.Mem3 = "1" Then Alerte.Hide          'ferme l'affichage si tempo Tp10 non échue
MemData.Mem1 = "0"                              'tempo Tp180 échue
MemData.Mem2 = "0"                              'RAZ point de comptage
MemData.Mem3 = "0"                              'CountDown : tempo Tp10 échue
End Sub
'************************************************************************************

'Ajouter une Form nommée MemData contenant 3 Textbox Mem1, Mem2, Mem3

'Ajouter une Form nommée "Alerte", Caption=" Fermeture dans 10 Secondes...", 
'contenant un bouton (nom ="Encore", Caption =CLIQUER POUR CONTINUER" et le code : 

Private Const HWND_TOPMOST As Long = (-1)
Private Const SWP_NOMOVE As Long = &H2
Private Const SWP_NOSIZE As Long = &H1
'************************************************************************************
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
'************************************************************************************
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
    ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
    ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'************************************************************************************

Private Sub UserForm_Activate()
'=> Affiche la UserForm au premier plan

Dim hwnd As Long
hwnd = FindWindowA("Thunder" & IIf(Application.VERSION Like "8*", "X", _
    "D") & "Frame", Me.Caption)
Call SetWindowPos(hwnd, HWND_TOPMOST, &H0, &H0, &H0, &H0, _
    SWP_NOMOVE Or SWP_NOSIZE)
'************************************************************************************

Private Sub Encore_Click()
'=> Relance la temporistaion de fermeture automatique

Relancer
End Sub
'************************************************************************************

'Ajouter dans chaque feuille

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'=>En cas de changement dans la feuille

Relancer    'lance la temporisation de fermeture automatique
End Sub

Conclusion :


Un fichier au reseau et non partagé "oublié" ouvert ne paralysera plus les autres utilisateurs... puisqu'il se fermera automatiquement après sa procédure d'alerte

A voir également

Ajouter un commentaire Commentaires
CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
17 avril 2010 à 00:56
J'avais dit que je mettrai de la musique... Jai aussi fait plus simple, je crois, ici :
http://www.vbfrance.com/codes/FERMETURE-AUTOMATIQUE-CLASSEUR-EXCEL-AVEC-ALARME_51629.aspx
Cdt
CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
15 avril 2010 à 21:01
Si je peux me permettre, mon code n'a pas à être "meilleur" ou pas, je souhaite seulement qu'il puisse être utile, et peut-être moins lourd, voire plus "élégant" si d'aventure quelqu'un s'en sent pour apporter ses lumières.
En attendant, la musique adoucissant les moeurs, il faudra que je pense à remplacer ces "beep" un peu vieux jeu par un sympatyhique WAV avec une commande shell par exemple...
Allez, zen!

Cdt
NikatorS Messages postés 147 Date d'inscription mercredi 18 septembre 2002 Statut Membre Dernière intervention 15 avril 2011
15 avril 2010 à 19:25
Salut à toi bigfish_le vrai,

Je vais la faire simple. Non ils ne font pas la même chose, et non la méthode du code que tu rappel n'est pas la meilleur.

Pourquoi ne font-ils pas la même chose ? Tu as pu voir que cette application bip et pas l'autre.
Pourquoi est-ce important ? Dans le cas de l'autre programme, si rien ne se passe au clavier et à la souris c'est que : tu réfléchis, tu répond au téléphone, tu discute avec quelqu'un ou tu n'es pas sur l'ordinateur ou pire encore, tu dors. Bref, tu ne regarde pas l'écran. Donc affiché un dé-compteur est plutôt inutile et un petit bip serait le bien venu dans certains des cas.

Parlons méthode maintenant. Celle de CerberusPau prend en compte que l'utilisateur ne se sert pas de son PC uniquement pour utiliser le fichier.xls, il peut travailler à autre chose. C'est plus qu'important.

Bref, ce code est, à mon opinion et pour les raisons précédemment citées, bien meilleur.
CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
15 avril 2010 à 13:26
Oups !
J'avais dû mal chercher... ou mal comprendre.
Ce code scrute l'activité UNIQUEMENT DANS LE FICHIER Excel en question (non pas du PC) et la Form d'alerte
est toujours ramenée en premier plan devant l'application sur laquelle l'utilisateur est par ailleurs.
Mon niveau de débutant est certes flagrant, et il y a certainement plus simple. Je ne demande qu'à apprendre.
Cdt
bigfish_le vrai Messages postés 1835 Date d'inscription vendredi 13 mai 2005 Statut Membre Dernière intervention 20 novembre 2013 14
15 avril 2010 à 11:04
Salut,

il y ici : http://www.vbfrance.com/codes/TIMEOUT-SOUS-VBA-EXCEL-FERMETURE-AUTOMATIQUE-APPLICATION_50755.aspx

un code qui fait EXACTEMENT la même chose !!!

D'autan que cet autre code utilise une meilleur méthode puisque qu'il s'appuie sur l'activité réel de l'utilisateur
De fait je ne vois pas l'intérêt de ton code.

Avant de poster il serait bien de vérifier !

A+
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)