Änderung der Alarmzeit

Hallo Freaks,
warum funktioniert die Alarmzeit (hier: 00:00:30) nur bei der Einstellung 30 s?
Wenn ich andere Werte eingebe, z.B. 10 s, 20 s, 40 s u.s.w, wird keine Wavdatei abgespielt. - Und wie baue ich in den Code ein, dass ab 10 s alle Sekunde, bis Erreichen 0 s, ein Signal abgespielt wird? (Countdown).
Nachstehenden Code habe ich mit freundlicher Unterstützung dieses Forums an meine Bedürfnisse angepasst. - Ich bin eine absolute VBA-Null.
Vielen Dank im voraus: Konni
ARBEITSMAPPE
Option Explicit


Private Sub Workbook_Open()
DaZeit = "0:01:00"
ThisWorkbook.Worksheets("Submissionen 1-50").Range("A11") = CDate(DaZeit)
Zeitmakro
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime EarliestTime:=ET, Procedure:="Zeitmakro", Schedule:=False
End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ThisWorkbook.Worksheets("Submissionen 1-50").Range("A11") = DaZeit
End Sub

MODUL 1
Option Explicit
Public ET As Variant
Public DaZeit As Date
Private Declare Function sndPlaySound32 Lib "winmm.dll" _
Alias "sndPlaySoundA" (ByVal lpszSoundName _
As String, ByVal uFlags As Long) As Long
Sub Zeitmakro()
With ThisWorkbook.Worksheets("Submissionen 1-50").Range("A11")
.Value = .Value - CDate("00:00:01")
If .Value 0 Then
ET = Now + TimeValue("00:00:01")
If .Value = TimeValue("00:00:30") Then
Call sndPlaySound32("C:\Winnt\media\klingel.wav", 1)
End If
Application.OnTime ET, "Zeitmakro"
Else
ThisWorkbook.Close True 'speichern
' Meldung bei Excel immer in Vordergrund
' Dim mldg
' mldg = MsgBox("Endzeit erreicht", 1048576, "Endzeit")
' 1048576 entspricht vbMsgBoxRtlReading
End If
End With
End Sub
Sub MacrosON()
'Dieses Macro ausführen wenn der Code zwischen
'Application.EnableEvents = False und
'Application.EnableEvents = True
'angehalten wurde oder abstürzt
Application.EnableEvents = True
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Function sndPlaySound32 Lib "winmm.dll" _ Alias "sndPlaySoundA" (ByVal lpszSoundName _ As String, ByVal uFlags As Long) As Long Sub Zeitmakro() Const Rundung As Double = 0.0000005 With ThisWorkbook.Worksheets("Submissionen 1-50").Range("A11") .Value = WorksheetFunction.Max(CDate(.Value) - CDate("00:00:05"), 0) If .Value <> 0 Then ET = Now + TimeValue("00:00:05") If Abs(.Value - CDbl(TimeValue("00:00:40"))) < Rundung Then _ Call sndPlaySound32("C:\Winnt\media\klingel.wav", 1) Application.OnTime ET, "Zeitmakro" Else ThisWorkbook.Close True 'speichern End If End With End Sub Gruß Andreas

Private Sub Workbook_Open() DaZeit = "0:02:00" 'oder DaZeit = ThisWorkbook.Worksheets("Tabelle1").Range("A1").Value IntervalCountdown = "00:00:02" 'oder IntervalCountdown = ThisWorkbook.Worksheets("Tabelle1").Range("A2").Value Vorwarnung = "00:00:40" 'oder analog siehe oben... Letztwarnung = "00:00:10" '... ThisWorkbook.Worksheets("Submissionen 1-50").Range("A11") = CDate(DaZeit) Zeitmakro End Sub

Hallo Andreas,
ich finde es toll, dass es Leute wie Dich gibt, die anderen selbstlos und aus Spaß an der Freud (mein Eindruck) unter die Arme greifen. Deine Lösung ist eine gute Lösung. Durch Zufall habe ich von einem Bekannten von dessen Bekannten erfahren, der VBA auch beherscht. - Ich glaube, diese Lösung ist etwas komfortabler. Für Dein Angagement bedanke ich mich sehr und sende Dir die andere Lösung für Deinen Gebrauch.
Aber eine Frage an Dich habe ich noch, ist mir gerade eingefallen: Wie integriere ich in meine Tabelle WAV-Dateien, die jedem Nutzer zur Verfügung stehen und somit von seinen PC-spezifischen WAV-Dateien unabhängig ist?
Nun der neue VBA-Code:
ARBEITSMAPPE
Option Explicit


Private Sub Workbook_Open()
DaZeit = "0:01:00"
ThisWorkbook.Worksheets("Submissionen 1-50").Range("A11") = CDate(DaZeit)
Zeitmakro
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime EarliestTime:=ET, Procedure:="Zeitmakro", Schedule:=False
End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ThisWorkbook.Worksheets("Submissionen 1-50").Range("A11") = DaZeit
End Sub

MODUL 1
Option Explicit
Public ET As Variant
Public DaZeit As Date
Private Declare Function sndPlaySound32 Lib "winmm.dll" _
Alias "sndPlaySoundA" (ByVal lpszSoundName _
As String, ByVal uFlags As Long) As Long
Sub Zeitmakro()
With ThisWorkbook.Worksheets("Submissionen 1-50").Range("A11")
.Value = .Value - CDate("00:00:01")
If .Value 0 Then
ET = Now + TimeValue("00:00:01")
If Second(.Value) = 30 Then
Call sndPlaySound32("D:\Windows\media\ringin.wav", 1)
End If
If Second(.Value) Call sndPlaySound32("D:\Windows\media\Windows XP-sprechblase.wav", 1)
End If
Application.OnTime ET, "Zeitmakro"
Else
ThisWorkbook.Close True 'speichern
' Meldung bei Excel immer in Vordergrund
' Dim mldg
' mldg = MsgBox("Endzeit erreicht", 1048576, "Endzeit")
' 1048576 entspricht vbMsgBoxRtlReading
End If
End With
End Sub
Sub MacrosON()
'Dieses Macro ausführen wenn der Code zwischen
'Application.EnableEvents = False und
'Application.EnableEvents = True
'angehalten wurde oder abstürzt
Application.EnableEvents = True
End Sub
Ich hoffe, dass Du mir nicht böse bist, weil ich persönlich die andere Lösung für besser halte.
Andreas, höre ich von Dir? Gruß: Konni

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread