Wo ist der Fehler im Code (VBA PowerPoint)?
Hallo meine lieben,
ich benötige wieder einmal eure Hilfe. Ich habe im Internet einen VBA Code gefunden der es ermöglich in einer PowerPoint Präsentation die aktuelle Uhrzeit mit Sekunden anzuzeigen. Da der Code leider nicht 64bit tauglich war hab ich ein wenig rumgetüftelt und siehe da, die Uhr selbst funktioniert schon mal. Aber leider bekomme ich ständig eine Fehlermeldung sobald die Folie gewechselt wird. "slides (unknown member): bad argument type. Excectet Collection index (string or integer). Ich verwende Windows 10 und Office 2016.
Würde mich rießig freuen wenn mir hier jemand weiterhelfen kann.
Vielen Dank im Voraus.
Leider ist der Code zu lange daher in 2 Teile.
Erster Teil:
Option Explicit
'API Declarations
Declare PtrSafe Function SetTimer Lib "user32" _
(ByVal hwnd As LongPtr, _
ByVal nIDEvent As LongPtr, _
ByVal uElapse As LongPtr, _
ByVal lpTimerFunc As LongPtr) As LongLong
Declare PtrSafe Function KillTimer Lib "user32" _
(ByVal hwnd As LongPtr, _
ByVal nIDEvent As LongPtr) As LongLong
' Public Variables
Public ClockTimerID As LongLong
Public prevSlideIdx As LongLong
Const TIMEFORMATSTRING As String = "dd.mm.yyyy - HH:mm:ss - KW :ww" 'show seconds with: "HH:mm:ss""
Dim pptEventObject As New Klasse1 'AppClassModule
'DIESE METHODE EINMALIG UNTER MAKROS STARTEN, DAMIT DAS EVENTHANDLING FUNKTIONIERT!
Sub InitializeApp()
Set pptEventObject.App = Application
End Sub
Sub StartClockTimer()
On Error GoTo ErrorOccurred
'first make sure its not already running
ClockTimerID = KillTimer(0, ClockTimerID)
ClockTimerID = SetTimer(0, 0, 1000, AddressOf TimerProcClock)
If ClockTimerID = 0 Then
MsgBox "Unable to create the clock timer", vbCritical + vbOKOnly, "Error"
Exit Sub
End If
Exit Sub
ErrorOccurred:
MsgBox Err.Description
End Sub
Sub StopClockTimer()
On Error GoTo ErrorOccurred
If Not ClockTimerID = 0 Then
ClockTimerID = KillTimer(0, ClockTimerID)
End If
Exit Sub
ErrorOccurred:
MsgBox Err.Description
End Sub
' The defined routine gets called every nnnn milliseconds.
Sub TimerProcClock(ByVal hwnd As LongPtr, _
ByVal uMsg As LongPtr, _
ByVal idEvent As LongPtr, _
ByVal dwTime As LongPtr)
On Error GoTo ErrHandler
If Not ActiveSlide Is Nothing Then
ActiveSlide.Shapes("PointaixClockLabel").TextFrame.TextRange.Text = WeekdayName(Weekday((Now()))) + " " + Format(Now(), TIMEFORMATSTRING)
End If
Exit Sub
ErrHandler:
End Sub