Alerte sonore

Bonjour

Une petit exemple qui ne répond peut être pas tout à fait à ton problème
https://www.cjoint.com/?3LkoSCR8jxh

Cdlmnt

Bonjour,

pour tester colle ce code dans un module

Sub Alerte()
'ActiveWorkbook.Save
'ActiveWorkbook.Close
Application.OnTime TimeSerial(Hour(Time), Minute(Time), Second(Time) + 2), "Alerte"
Beep
End Sub

et celui ci dans la Thiswokbook

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("01:00:00"), "Alerte"
End Sub

A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

Mike,

C'est tout à fait ce que je voulais, j'aimerais bien, si c'est possible mettre quand l'alerte sonne une tête de mort avec écris en dessous
Laissez travailler ceux qu'ils veulent travailler

Dis moi si c'est faisable sinon, l'alerte me convient, c'est suoer cool

Encore 1000 merci à vous tous.

Re,

oui c'est tout à fait possible mais pourquoi alourdir inutilement un fichier, je verrais plus une alerte sonore au bout de 45 minutes par exemple et au bout d'une heure enregistrement et fermeture du fichier.

c'etait pour rire un peu, ils m'énervent tellement que des fois, bref, oui ce serait mieux ainsi avec enregistrement et fermeture
super bonne idée mieux que le mienne je te l'accorde

merci encore

Re,

teste ces codes, dans le module colle ces deux codes

Sub Alerte()
Application.OnTime TimeSerial(Hour(Time), Minute(Time), Second(Time) + 2), "Alerte"
Beep
End Sub

Sub Fermeture()
'ActiveWorkbook.Save
'ActiveWorkbook.Close
End Sub

dans le Thiswokbook

ce code

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:50:00"), "Alerte"
Application.OnTime Now + TimeValue("01:00:00"), "Fermeture"
End Sub

au bout de 50 minutes ça sonne et au bout d'une heure enregistrement et fermeture du fichier

j'ai changé les horaires pour voir si cela fonctionne j'ai mis 5sec pour l'alerte et 10 sec pour la fermeture et ça ne fonctionne pas, l'alerte est là mais le fichier ne se ferme pas

ça enregistre mais ne ferme pas

Re,

remplace
ActiveWorkbook.Close

par
Application.Quit

mais la fermeture d'Excel peut vite devenir gênante, je regarde comment arrêter le beep avant fermeture

je te remercie pour ton investissement

Re,

dans ton module colle ces codes

Option Explicit

Dim BlinkTime As Date

Public Sub Alerte()
Beep
BlinkTime = Now() + TimeValue("00:00:02") 'le temps du clignotement
Application.OnTime BlinkTime, "Alerte"
End Sub
Sub StopAlerte()
On Error Resume Next
Application.OnTime BlinkTime, "Alerte", , False
End Sub

Sub Fermeture()
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

si tu préfères fermer Excel et non pas le classeur, remplace

ActiveWorkbook.Close
par
Application.Quit

dans la Thiswokbook ce code

Option Explicit

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:55:00"), "Alerte"
Application.OnTime Now + TimeValue("00:05:00"), "StopAlerte"
Application.OnTime Now + TimeValue("01:00:00"), "Fermeture"
Exit Sub
End Sub

le beep sonore débute au bout de 55 minutes pendant 5 minutes, le fichier s'enregistre et se ferme.
Il est possible également d'envisager un code pour forcer la fermeture du fichier après un temps d'inactivité exemple 15 minutes, ce qui pourrait être plus judicieux que d'attendre 1 heure
A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

oui mais si je mets
Application.OnTime Now + TimeValue("01:00:00"), "Fermeture"
Application.OnTime Now + TimeValue("00:15:00"), "Fermeture" , ça doit le fermer et l'enregistrer

Re,

non il y a un problème dans ta programmation cette ligne OK
Application.OnTime Now + TimeValue("01:00:00"), "Fermeture"
mais cette ligne doit mettre Excel en live puisque tu programme la fermeture 15 minutes plus tard
Application.OnTime Now + TimeValue("00:15:00"), "Fermeture"

teste ce code, celui d'hier soir (la fatigue) n'est pas chronologique, et on en reparle
après 55 minutes, beep sonore, arrêt de la procédure sonore après 59 minutes pour libérer Excel et fermeture au bout d'une heure

Application.OnTime Now + TimeValue("00:55:00"), "Alerte"
Application.OnTime Now + TimeValue("00:59:00"), "StopAlerte"
Application.OnTime Now + TimeValue("01:00:00"), "Fermeture"

c'est nickel de chez nickel, il vont être très très embêtés et moi je vais pouvoir travaillé tranquille sans stress grâce à toi Mike

il y a quelque temps j'avais mis un post sur ccm concernant un soucis de cellule coloriées, en effet j'avais réussi à coloriée des cellules d'une feuille à une autre via les mfc mais le soucis j'en ai plusieurs dizaine de dizaine à faire et comme je suis sur les stats parce que fin d'année oblige, j'avais demandé si on pouvait faire une macro pour synchoniser les feuilles

je l'ai testé sur une feuille vierge et ça fonctionne à merveille mais quand je mets tes codes dans mon dossier ou il y a des liens et une petite macro et des mfc, ça beug, il demande d'enregistrer et quand j'annule il me fait debogage et le message suivant

Erreur d'execution '1004'
Dimension spécifié non valide pour le type de graphique en cours

et quand j'annule l'enregistrement, il me renvois à la macro et j'ai
ActiveWorkBook,save en jaune

??

Re,

teste ce code plus stable qui temporise l'inactivité que j'ai programmé à 5 minutes,
remplace les codes précédents par ce code dans un module

Option Explicit
Option Private Module
'Ti
'Delai est le temps d'inactivité maxi en minutes
Const Delai = 5
Sub Programmation()
Dim Heure As Date
Heure = Now + TimeValue("00:" & Delai & ":00")
ThisWorkbook.Names.Add Name:="ChronoTime", RefersTo:=Heure
ThisWorkbook.Names.Add Name:="Chrono", RefersTo:=0
Application.OnTime Heure, "Interruption"
'[B2].Interior.ColorIndex = 3
End Sub
Private Sub Interruption()
With ThisWorkbook
If .Sheets(1).Evaluate("Chrono") = 0 Then
.Save
.Close
Else
Programmation
End If
End With
End Sub
Sub SupprimeInterruption()
Dim Heure As Date
On Error Resume Next
Heure = ThisWorkbook.Sheets(1).Evaluate("ChronoTime")
Application.OnTime Heure, "Interruption", schedule:=False
End Sub

et ces codes dans la Thiswokbook

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
SupprimeInterruption
End Sub
Private Sub Workbook_Open()
Programmation
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
ThisWorkbook.Names("Chrono").Value = 1
End Sub

A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

pareil que la derniere fois, ça demande d'enregistrer et il n'y a plus d'heure ni de son

Re,

Plus d'heure ni de son n'a rien à voir, peux tu copier un exemple de fichier sans note confidentielle mais avec tes macros que je vois le conflit

voilà le lien

http://cjoint.com/?CLlnYGOY0hQ

merci

Re,

Dans quelle cellule utilises tu la fonction SomCoul