Déclencher un son
Catégorie : Evènements
Publié par veriland le 12-Aug-2013 21:40

Déclenchement du son "Alerte.wav" (présent dans le dossier) toutes les 5 secondes...pour les minutes Il faut modifier le paramètre "délai" dans la macro
 
partie à coller dans Thisworboock

module
 
Option Explicit

' Ti et Vériland Décembre 2003
' Petite procédure pour fermer
' le prog sans l'enregistrer
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  SupprimeInterruption
  Application.DisplayAlerts = False
    With ThisWorkbook
        .Close
    End With
  Application.DisplayAlerts = True
End Sub

Private Sub Workbook_Open()
  Programmation
End Sub
 
partie à coller dans un module

module
 
Option Explicit
'Ti Décembre 2003
'Déclaration pour avoir du son WAV
Private Declare Function PlaySound32 Lib "winmm.dll" Alias "PlaySoundA" (ByVal IpszName As String, ByVal hModule As Long, ByValdwFlags As Long) As Long
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000
Public MusicWAV

'Delai est le temps d'inactivité en secondes
'on peut le définir en minutes il suffit de changer
'Heure = Now + TimeValue("00:& Delai &":00" )
'plus bas
Const Delai = 5

Sub Programmation()
Dim Heure As Date
  Heure = Now + TimeValue("00:00:" & Delai)
  'on sauvegarde l'heure de la dernière programmation pour éventuellement
  'pouvoir la supprimer à la fermeture du fichier
  ThisWorkbook.Names.Add Name:="ChronoTime", RefersTo:=Heure
  ThisWorkbook.Names.Add Name:="Chrono", RefersTo:=0

  Application.OnTime Heure, "Interruption"
End Sub

Private Sub Interruption()
  With ThisWorkbook
  
    If .Sheets(1).Evaluate("Chrono") = 0 Then
      MusicWAV = ThisWorkbook.Path & "Alerte.wav"
      PlayWAV
     ThisWorkbook.Names.Add Name:="ChronoTime", RefersTo:=0
     Programmation
    Else
      Programmation
    End If
  End With
End Sub

Sub SupprimeInterruption()
'supprime le timer à la fermeture du fichier, s'il ne l'est pas déjà.
'Sinon le fichier risque de se rouvrir tout seul !
Dim Heure As Date
  On Error Resume Next
  Heure = ThisWorkbook.Sheets(1).Evaluate("ChronoTime")
  Application.OnTime Heure, "Interruption", schedule:=False
End Sub

' pour le son
Sub PlayWAV()
    Call PlaySound32(MusicWAV, 0&, SND_ASYNC Or SND_FILENAME)
End Sub