alerte sonore Résolu/Fermé

Question

Bonjour le Forum

Est-il possible de créer une alerte sonore et visuel quand un fichier est ouvert plus d'une heure,

Je travaille en réseau et mes collègues monopolisent des fichiers excel, et c'est très désagréable d'essayer de rattraper le temps 

Par avance, merci

Cordialement

Éric 2027

ccm81 · Answer

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

Mike-31 · Answer

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.

eric2027 · Answer

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.

Mike-31 · Answer

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.

eric2027 · Answer

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

Mike-31 · Answer

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

eric2027 · Answer

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

eric2027 · Answer

ça enregistre mais ne ferme pas

Mike-31 · Answer

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

eric2027 · Answer

je te remercie pour ton investissement

Mike-31 · Answer

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.

eric2027 · Answer

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

Mike-31 · Answer

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"

eric2027 · Answer

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

eric2027 · Answer

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

??

Mike-31 · Answer

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.

eric2027 · Answer

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

Mike-31 · Answer

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

eric2027 · Answer

voilà le lien

http://cjoint.com/?CLlnYGOY0hQ

merci

Mike-31 · Answer

Re,

Dans quelle cellule utilises tu la fonction SomCoul

eric2027 · Answer

dans l'onglet recap, dimanche, jour férié

Mike-31 · Answer

Re,

Pour compter les couleurs, tu as cette fonction personnalisé 

Function CompteRouge(Plage As Range)
Application.Volatile True
For Each Cell In Plage
If Cell.Interior.ColorIndex = 3 Then Somme = Somme + 1
Next
CompteRouge = Somme
End Function

que j'ai utilisé sur la ligne 29 de la feuille
recap dim, jour ferie


pour activer la mise à jour de la fonction personnalisé, j'ai ajouté un Calculate dans la Thiswokbook que tu peux utiliser avec ta fonction si tu la conserves

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
    ThisWorkbook.Names("Chrono").Value = 1
    Calculate
End Sub
 
quand au code de fermeture du fichier aucun problème sur Excel 2010 

	https://www.cjoint.com/c/CLlsGEQoqD4

eric2027 · Answer

Tu as fait un boulot de fou ça fonctionne à merveille 

est ce que mon fichier était trop avec sommecoul ? parce que je pensais que c'était une bonne idée de travailler comme ça

au fait je n'ai plus de beep, est ce normal ?

si je veux que le fichier se ferme dans 30 minutes, je remplace 5 par 30 ?

encore merci Mike pour ce que tu as fait, je vais pouvoir travailler et faire mes stat tranquillement sans angoisse

Mike-31 · Answer

Re,

Bizarre que tu n'ai pas le beep, dans la journée je te ferai un petit fichier test pour le tester.
pour moduler la fermeture oui c'est cela tu modifies la constante 5, mais ne le mets pas trop long, c'est le temps d'inactivité sur le fichier, il suffit d'avoir une action sur le fichier pour relancer le chrono

SommeCoul fonctionne très bien, j'ai simplement allégé le code avec CompteRouge et du même la formule qui avec SommeCoul
=SomCoul(fev14!D36:AE36;"rouge")
comparée à mon code
=CompteRouge(fev14!D35:AE35)
si tu la préfères tu peux encore l'alléger en changeant  la syntaxe CompteRouge par C_Coul
ce qui te donnera dans la formule
=C_Coul(fev14!D35:AE35) tu gagnes une dizaine d'octets multiplié par x formules cela fait pas mal sur le poids du fichier

eric2027 · Answer

donc je peux retirer les formules qui sont dans mon fichier recapdim, ce que alegera mon fichier

Mike-31 · Answer

Re,

Excuse le temps passe vite, oui tu peux réécrire la fonction si tu optes pour cette modif je te dirai point par point la méthode pour les modifier en deux clic.

sur la feuille "recap dim, jour ferie" tu peux suivre provisoirement le déroulement du décomptes avant la fermeture du fichier, je t'ai mis une shape bleu pour te permettre la suspension du décompte que nous amélioreront plus tard.

au départ le fichier est disponible environ 1800 secondes (une 1/2 heure) sans activité, à 30 secondes de la fin de ce temps tu as un Beep et à 0 l'enregistrement et la fermeture du fichier

 https://www.cjoint.com/c/CLopIpGwrra
 
A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

Mike-31 · Answer

Re,

j'ai relancé cette discussion, et traite chaque discussion dans la discussion sinon on ne va pas s'y retrouver.

sur quelle feuille sont tes mises en forme conditionnelles ,


pour l'autre discussion, je ne vois pas

narvalot · Answer

apparement ça a été retiré, je ne sais pas par qui, c'est bizarre parce que j'avais mis un lien, et comme il est au travail, je te l'envois lundi

merci encore c'est vraiment sympa de ta part de me sortir de ce tunnel ou je ne voyais pas le bout

Mike-31 · Answer

Re,

tu peux m'en dire un peu plus sur ton fichier, je pense que semaine 50 la cellule en bleu dont tu parles est la E30 et G30, 
que veux tu faire créer une mise en forme conditionnelle si par exemple tu saisie dans une cellule Upe elle se met en jaune, ou veux tu compter les cellules de toutes tes semaines par couleur et pourquoi pas les deux ?

narvalot · Answer

ce que j'aimerais c'est que quand les cellules dépassent 0 par exemple "brigade centre en i34, il y a 3 agents qui sont venu, donc en semaine 50 en colonne AA, elles deviennent bleu comme cette mfc, ='Brigade centre '!$I$34>0

c'est à dire que quand les agents viennent au sport ils soit comptabilisés et que le résultat s'inscrivent en couleurs

Mike-31 · Answer

Re,

Le principal avant de se lancer est de bien cerner le problème.
si feuille "Brigade centre" tu saisis une valeur exemple en I34, elle se reporte feuille semaine 50  cellule AA6 et la cellule se colorise si j'ai bien compris cellule AI6 devrait se coloriser de la même manière ?

tu devrais uniformiser tes feuilles Brigade centre, Vtt centre etc de sorte à avoir les critères sur les mêmes cellules

A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

narvalot · Answer

oui c'est ça,

 j'ai fait ce tableau en vitesse, qu'entends tu par uniformiser ?

le résultat en i34, est du fait d'une formule nb.si, et elle se reporte en colonne AA
et ce, sur tout les jours des semaines, lundi = AA, mardi = AE, mercredi = AI etc...

donc le résultat de J33 ira sur semaine 50, AE
le résultat de K33 ira sur semaine 50, AI etc...

Mike-31 · Answer

Re,

Uniformiser, que tous les tableau soient identiques, que les colonnes comme les lignes soit semblable, mais je n'avais pas remarqué que feuille Cvo les colonnes étaient masquées.

regarde feuille Brigade centre en J2 le format personnalisé, il suffit de saisir le numéro semaine exemple 50
automatiquement en I5 tu as une formule qui te donne le premier jour semaine sans passer par la date en K4, il suffit de sélectionner l'année dans une cellule nommée que j'ai mis en feuille Couleurs C1

en F3 j'ai mis une formule qui n'utilise pas la cellule nommée et prends l'année en cours

regarde tes mises en forme si elles répondent à tes attentes

	https://www.cjoint.com/c/CLqmuuLWFlO

narvalot · Answer

C'est exactement ce que je voulais, par contre il ne me prend pas pour les semaines suivantes.

Comme je vais continuer à gérer ces agents sur l'année 2014, je voulais faire 52 semaines avec ces formules, mais après des tests, il reste que la semaine 50,
parce qu'on me demande des stats sur les mois, trimestres, semestres et annuelle.
Donc je voulais faire une formule en somme, comme ça je pourrais préparer mes tableaux et camenberts sans stress

Mike-31 · Answer

Re,

Si tu crées un fichier par an, en feuille Couleurs C1 tu sélectionnes 2014 et feuille Brigade centre en J2 tu saisis la semaine et tu as automatiquement la date du lundi en feuille Brigade centre en I4

si tu travaille sur le même fichier, feuille Brigade centre en I4 utilise cette formule

=SI(ESTNUM(I2);7*I2+DATE(2013;1;3)-JOURSEM(DATE(2013;1;3))-5;"")
 
à adapter pour les autres semaines, et pour passer en 2014 il suffit de changer simplement l'année

=SI(ESTNUM(I2);7*I2+DATE(2014;1;3)-JOURSEM(DATE(2014;1;3))-5;"")

narvalot · Answer

Mike,

Un grand grand merci à toi, pour mes stats, c'est le top de chez top.

Merci pour ton investissement et ta rapidité, tu me sors d'une souffrance, parce que sans toi et tes formules,  je n'aurais pu finir les stats pour la fin d'année.

Encore merci à toi et o Forum, 
je mets en résolu

Mike-31 · Answer

Re,

Merci à toi et bonne fête

narvalot · Answer

Bonnes fêtes à toi et o forum

Alerte sonore

38 réponses

Discussions similaires