Hallo zusammen,
für die Hochzeit meiner Schwester möchte ich gerne ein Spiel vorbereiten und brauche dafür eine ppt in der auf mehreren Folien (11 Stück) ein 40 Sekundentimer rückwärts läuft. Wenn er bei 00:00 angelangt ist, soll eine Sounddatei abgespielt werden, die das Ende akustisch verlauten lässt. (die Datei steht noch nicht, wahrschl wave-file.)
Ich habe hier im Forum schon ein VBA Script gefunden, mit dem ich einen Timer machen kann, aber der bezieht sich leider die ganze Präsi. Ich brauche einen Timer, den ich per mausklick starten kann und mehrere Male in der ppt verwenden kann, wobei er natuerlich immer wieder bei 40 seks startet und auf 00:00 runterzählt.
Der Code, den ich bisher gefunden habe, hilft mir da nur bedingt und ich verstehe es nicht, ihn entsprechend abzuändern:
Sub InitializeApp()
Set X.App = Application
End Sub
Public Sub zeit()
Dim laenge, Start, Ende
Set firstSl = Application.ActivePresentation.SlideMaster
laenge = 40 ' Dauer festlegen.
Start = Timer ' Anfangszeit setzen.
Ende = Start + laenge
Do While (Timer < Ende) And (pre_stop = False)
firstSl.Shapes(1).TextFrame.TextRange.Text = Format((Ende - Timer) / (24 * 60), "hh:mm:ss")
DoEvents ' Steuerung an andere Prozesse
' abgeben.
Loop
firstSl.Shapes(1).TextFrame.TextRange.Text = "00:00:00" 'hier steht das, was am ende stehenbleiben soll!
Set firstSl = Nothing
End Sub
Kann mir jemand helfen?
viele Grüße
Philipp
für die Hochzeit meiner Schwester möchte ich gerne ein Spiel vorbereiten und brauche dafür eine ppt in der auf mehreren Folien (11 Stück) ein 40 Sekundentimer rückwärts läuft. Wenn er bei 00:00 angelangt ist, soll eine Sounddatei abgespielt werden, die das Ende akustisch verlauten lässt. (die Datei steht noch nicht, wahrschl wave-file.)
Ich habe hier im Forum schon ein VBA Script gefunden, mit dem ich einen Timer machen kann, aber der bezieht sich leider die ganze Präsi. Ich brauche einen Timer, den ich per mausklick starten kann und mehrere Male in der ppt verwenden kann, wobei er natuerlich immer wieder bei 40 seks startet und auf 00:00 runterzählt.
Der Code, den ich bisher gefunden habe, hilft mir da nur bedingt und ich verstehe es nicht, ihn entsprechend abzuändern:
Sub InitializeApp()
Set X.App = Application
End Sub
Public Sub zeit()
Dim laenge, Start, Ende
Set firstSl = Application.ActivePresentation.SlideMaster
laenge = 40 ' Dauer festlegen.
Start = Timer ' Anfangszeit setzen.
Ende = Start + laenge
Do While (Timer < Ende) And (pre_stop = False)
firstSl.Shapes(1).TextFrame.TextRange.Text = Format((Ende - Timer) / (24 * 60), "hh:mm:ss")
DoEvents ' Steuerung an andere Prozesse
' abgeben.
Loop
firstSl.Shapes(1).TextFrame.TextRange.Text = "00:00:00" 'hier steht das, was am ende stehenbleiben soll!
Set firstSl = Nothing
End Sub
Kann mir jemand helfen?
viele Grüße
Philipp
