Fermeture automatique classeur excel avec alarme
Soyez le premier à donner votre avis sur cette source.
Vue 10 130 fois - Téléchargée 1 092 fois
Description
La fermeture automatique d'un classeur Excel inactif laissé ouvert est précédée d'un message affichant en premier plan un décompte des X dernières secondes et d'un avertissement sonore (fichier Wav ou Bip/seconde).
=> Détection de l'activité spécifique au classeur par : SelectionChange
=> Bip par : APIBeep Lib "kernel32"
=> Son par : PlaySound Lib "winmm.dll"
=> Premier plan : SetWindowPos Lib "user32"
Tout est dans le fichier Tempo.zip
=> fichier Wav = Beethoven.Wav (à copier sous C:\)
Ce fichier faisant 1,8Mo je ne peux le joindre ici. Je vous l'adresserai par mail sur demande
A l'ouverture une tempo de 3mn est activée, et relancée lors de toute action dans une feuille du classeur. Au bout de 3mn d'inactivité, le décompte des 10 dernières secondes s'affiche et le fichier Wav est joué (ou les Bip déclenchés). Un bouton permet de reprendre la main avant que le fichier ne se sauvegarde et ne se ferme.
=> Détection de l'activité spécifique au classeur par : SelectionChange
=> Bip par : APIBeep Lib "kernel32"
=> Son par : PlaySound Lib "winmm.dll"
=> Premier plan : SetWindowPos Lib "user32"
Tout est dans le fichier Tempo.zip
=> fichier Wav = Beethoven.Wav (à copier sous C:\)
Ce fichier faisant 1,8Mo je ne peux le joindre ici. Je vous l'adresserai par mail sur demande
Source / Exemple :
'Ajouter dans Thisworbook
'************************
Private Sub Workbook_Open()
StartTempo
End Sub
'----------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTempo
End Sub
'----------------------
'Ajouter dans chaque feuille
'***************************
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Relancer
End Sub
'----------------------
'Ajouter dans la Form "Alerter"
'******************************
'PROPRIETE => ShowModal = False
'BOUTON => Name = Encore + Caption = Cliquer pour Continuer
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()
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
End Sub
'----------------------
Private Sub Encore_Click()
Relancer
End Sub
'----------------------
'Ajouter dans le module "TempoWav"
'*********************************
Option Explicit
Public Tp180s As Variant
Public MemData As Etat '(S Nikator)
'----------------------
Type Etat '(S Nikator)
Mem1 As Boolean
Mem2 As Boolean
End Type
'----------------------
Private Const SND_ASYNC = &H1
Private Const SND_FILENAME = &H20000
Private Const SND_PURGE = &H40
'----------------------
Private Declare Function APIBeep Lib "kernel32" Alias "Beep" _
(ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
'----------------------
Sub StartTempo()
Tp180s = Now + TimeValue("00:03:00")
Application.OnTime Tp180s, "AlerteFin"
MemData.Mem1 = True
End Sub
'----------------------
Sub AlerteFin()
MemData.Mem1 = False
MemData.Mem2 = True
Alerter.Show
Décompter
End Sub
'----------------------
Sub Décompter()
Dim T As Long
OuvreWav
Application.ScreenUpdating = True
Dim i
For i = 1 To 12 '2s ajoutées pour le temps du chargement du Wav
If MemData.Mem2 = False Then Exit Sub
Application.Wait (Now + TimeValue("00:00:01"))
DoEvents
T = 12 - i
Alerter.Caption = " Fermeture dans " & T & " Secondes"
'Beep 'A décommenter si Bip à chaque seconde au lieu de Wav
Next i
MemData.Mem1 = False
MemData.Mem2 = False
Alerter.Caption = "Fermeture dans 12 Secondes"'mettre 10 pour Beep
Alerter.Hide
Application.DisplayAlerts = False
WbC = Workbooks.Count
If WbC < 2 Then
ThisWorkbook.Save '(S Nikator)
Application.Quit
Else
ThisWorkbook.Save '(S Nikator)
ThisWorkbook.Close '(S Nikator)
End If
End Sub
'----------------------
Sub Relancer()
Alerter.Hide
FermeWav
On Error Resume Next
Application.OnTime Tp180s, "AlerteFin", , False
MemData.Mem1 = False
MemData.Mem2 = False
StartTempo
End Sub
'----------------------
Sub StopTempo()
On Error Resume Next
Application.OnTime Tp180s, "AlerteFin", , False
MemData.Mem1 = False
MemData.Mem2 = False
End Sub
'----------------------
Sub OuvreWav()
PlaySound "c:\Beethoven.wav", ByVal 0&, SND_FILENAME Or SND_ASYNC
End Sub
'----------------------
Sub FermeWav()
PlaySound vbNullString, ByVal 0&, SND_PURGE
End Sub
'----------------------
Conclusion :
A l'ouverture une tempo de 3mn est activée, et relancée lors de toute action dans une feuille du classeur. Au bout de 3mn d'inactivité, le décompte des 10 dernières secondes s'affiche et le fichier Wav est joué (ou les Bip déclenchés). Un bouton permet de reprendre la main avant que le fichier ne se sauvegarde et ne se ferme.
Codes Sources
A voir également
- Fermeture automatique classeur excel avec alarme
- Vba créer un nouveau classeur et le nommer ✓ - Forum VBA Office (Excel, Word ...)
- Vba excel ouvrir un classeur ✓ - Forum Visual Basic 6
- Tous les codes vba excel - Conseils pratiques -Visual Basic / VB.NET
- Excel vba doevents - Conseils pratiques -Visual Basic / VB.NET
- Excel copie automatique cellule d'une feuille à l'autre vba ✓ - Forum Visual Basic
20 avril 2010 à 21:22
Le résultat est nikel ! Pile-poil ce que j'en attendais.
Il y a cependant deux points à travaillez.
1)
Workbooks("Tempo.xls").Save => ThisWorkbook.Save
Workbooks("Tempo.xls").Close => ThisWorkbook.Close
Ainsi, si on renomme ton fichier, le code plante pas.
2)
"MemData" est une UserForm
Là j'ai envie de dire "Pas bien !! Scandale !!" Mais bon, je dirais rien ;-) juste que ça prend de l'espace pour rien.
Déclares plutôt une structure et remplaces la nature de tes variables, de String à Boolean.
Type Etat
Mem1 As Boolean
Mem2 As Boolean
End Type
Public MemData As Etat
Puis à l'utilisation :
MemData.Mem1 = False 'RAZ Tempo Tp180s
MemData.Mem2 = False 'RAZ Tempo Tp10s
Voilà, j'espère que ça te sera utile.
S Nikator
21 avril 2010 à 09:43
C'est vrai: Avec ma façon d'extraire des bouts de code d'une application que j'ai créée pour le proposer en source, j'oublie de simplifier...
1° Dans mon appli, il y a une deuxième boucle d'analyse des classeurs ("esclaves") ouverts et la fermeture auto peut être "dirigée" vers l'un d'eux, avant de fermer ThisWorkbook
2° Textbox créées car je peux être amené à les appeler par une autre appli qui doit voir si une des tempo tourne et bloquer son rebouclage.
21 avril 2010 à 19:50
Mais pour le point 2, je reste pas d'accord. Puisque ma variable "MemData" est public, tu peux l'appeler de n'importe où. Ce n'est pas la peine d'utiliser une UserForm.
Bon je continue sur ma lancé, car j'ai testé ce code plus en profondeur, aujourd'hui.
3) Les variables Tp10s, WbC et T sont public ce qui n'est pas nécéssaire mais la raison doit être la même que pour 1). J'ai quand même un gros doute pour WbC.
4) La fonction Application.OnTime n'est pas un timer mais plutôt une tâche planifier. Autre problème du à OnTime, si l'événement ne s'est jamais produit une fois, on ne peut le désactiver. Résultat : si le fichier à été fermé il se rouvre.
Il faut donc utiliser un vrai Timer.
5) Si le fichier est en lecture seul, il n'y a de raison de chercher à le fermer.
Private AlerteFinID As Long
'************************************************************************************
Public Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long) As Long
'************************************************************************************
Sub StartTempo()
'=> Lancement de la durée d'accès libre (5 minutes avant alerte de relance)
Dim Minutes As Single, Secondes As Single, Durée As Single
If ThisWorkbook.ReadOnly = True Then Exit Sub ' Le fichier est en lecture seule, il n'y a pas de raison de le fermer
Minutes = 5
Secondes = 0
Durée = Minutes * 60 + Secondes 'définit la durée de 300 secondes avant de lancer la prodédure de fermeture automatique
AlerteFinID = SetTimer(0&, 0&, Durée * 1000&, _
AddressOf AlerteFin) 'appelle la procédure de fermeture automatique
MemData.TpIn = True 'tempo AlerteFinID activée
End Sub
'************************************************************************************
Sub Relancer()
'=> Arrêt du processus automatique de fermeture et relance
Alerter.Hide
FermerAlerteFin 'arrêt de tempo AlerteFinID si engagée
MemData.TpIn = False 'RAZ tempo AlerteFinID
MemData.TpDe = False 'RAZ tempo Tp10s
StartTempo 'engage la relance
End Sub
'************************************************************************************
Sub AlerteFin(ByVal HWnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)
'=> Message de Relance (Arrêt Automatique engagé dans les 10 secondes)
MemData.TpIn = False 'tempo AlerteFinID échue
MemData.TpDe = True 'tempo Tp10s activée
Alerter.Show 'affichage du temps restant et du bouton de relance
Décompter 'lance le décompte final
End Sub
'************************************************************************************
Sub StopTempo()
'=> Arrêt du processus automatique de fermeture
FermerAlerteFin 'arrêt de tempo AlerteFinID si engagée
MemData.TpIn = False 'RAZ tempo Tp300s
MemData.TpDe = False 'RAZ tempo Tp10s
End Sub
'************************************************************************************
Sub FermerAlerteFin()
If ThisWorkbook.ReadOnly = True Then Exit Sub ' Le fichier est en lecture seule, il n'y a pas eu de raison de le fermer
'On Error Resume Next
KillTimer 0&, AlerteFinID 'arrêt du Timer "AlerteFinID"
End Sub
'************************************************************************************
Si je vois autre chose demain, je te fais signe.
21 avril 2010 à 21:54
une idée fort intéressante ^^
Dans ma boîte, ils ont la manie (affreuse a mon gout) de tout metre dans des fichiers excel et en particulier des données utiles à plusieurs utilisateurs.
On pourrait étayer un peut plus l'idée.
Il faudrait que la gestion ne soit pas dans un fichier mais en tant que macro globale a tous les classeurs.
Il faudrait que la macro se lance au démarrage d'une instance d'excel
Avec une classe cSPY
comprenant le nom d'un classeur
son identifiant unique et inchangeant dans l'instance
sa date et heure d'ouverture
A chaque ouverture d'un classeur on initialise un objet cSPY que l'on stoque
A chaque fermeture d'un classeur on détruit la classe cSPY associée
On trouve un moyen pour détecter l'inactivité sur un classeur (par classeur ou sur tous les classeurs ...)
On applique le warning (par balloon et systray ?) puis on quite le classeur.
Avec sauvegarde (mais locale, faut pas écraser l'originale sans demander l'avis >_< )
On peut même utiliser un fichier de config ".ini" pour définir le temps pour la détection, le son a jouer et encore + mieux
"une liste d'exclusion de fichiers" c'est a dire la liste des noms de classeurs a ne pas prendre en compte pour la détection / fermeture.
bon ca c la version simple, on peut imaginer encore mieux avec envoie a un serveur de l'information d'appropriement d'un classeur. comme ca on sait c qui qui bloque le fichier pour tout le monde >_<
enfin, avoir un moyen de désactiver ou empêcher notre fonction de s'appliquer a un classeur
(ajouter une entrée temporaire a la liste d'exclusion par exemple ^^)
bon c juste une idée comme ca. si j'avais du temps je pourrais en faire des choses ^^
21 avril 2010 à 21:57
L'intérêt, c'est justement d'éviter un timer, en appelant :
130.Application.OnTime Tp180s, "AlerteFin", , False
qui ferme le OnTime quand on quitte.
Moi, ça ne se "rouvre" pas.
Mais j'ai peut-être ai-je mal compris...
Pour T, Tp10s et Wbc, j'aurai pu effectivement les mettre en Dim, mais j'utilisais ces variables ailleurs: Je ne maîtrise vraissemblablement pas la différence entre Explicit + Dim et Explicit + Public... faut que j'aille voir un tuto quelque part!
Quant aux User, j'ai suivi a remarque et ça fonctionne, je ne le soupçonnais pas et en ai pris bonne note.
Enfin, le Lecture seule, dans mon appli, ce fichier ne l'est jamais, mais effectivement il fallait prévoir que pour une autre appli, il puisse l'être.
Merci encore.
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.