Powerpoint voert code niet meer uit (Timer probleem?)

Status
Niet open voor verdere reacties.
E

EenTouw

Gebruiker
Lid geworden
3 jun 2009
Berichten
39
Hallo allemaal,

Ik wilde een programma maken dat telt hoeveel calorieen je tijdens je presenatie zou kunnen verbranden. Het resultaat is het volgende:

Verklaren:
Code: 
Dim Cal_B As Integer
Dim i As Integer
Dim iTime, Start As Single

Functie om elke 4 seconden een calorie te laten verbranden
Code: 
Sub cal()
    Cal_B = 0
        While Cal_B < 1000                                                  'Kan alles zijn, zolang het programma maar doorloopt
            With ActivePresentation.Slides(1).Shapes("Oval 4")
            .TextFrame.TextRange.Text = Cal_B
            iTime = 4                                                       'Tijd die je nodig hebt voordat het getal omhoog gaat
            Start = Timer                                                   'Het starten van de klok (Start krijgt de tijd in seconden sinds middernacht mee)
            Do While Timer < Start + iTime                                  'Blijf niets doen tot "iTime" verstreken is
            DoEvents
            Loop
            i = ActivePresentation.SlideShowWindow.View.CurrentShowPosition 'Controleer of presentatie nog draait en op welke dia
            If i = 1 Then                                                   'Slide 1 = doorgaan
                Cal_B = Cal_B + 1
            ElseIf i = 2 Then                                               'Slide 2 = andere functie aanroepen
                Call dus
                End
            Else
                End                                                         'Dit betekent einde van de presentatie en dus stoppen met de code
            End If
            End With
        Wend
End Sub

Functie om te code te starten wanneer slide1 opent
Code: 
Sub OnSlideShowPageChange()
    
    i = ActivePresentation.SlideShowWindow.View.CurrentShowPosition         'Het opstarten van de code in de presentatie
    If i = 1 Then
    Call cal
    End If
End Sub

Functie om wat te zeggen over het aantal aan het eind
Code: 
Sub dus()
With ActivePresentation.Slides(2).Shapes("Rectangle 9")                     'Hier wordt tekst toegevoegd aan een vorm zodat je er wat over kan vertellen
            .TextFrame.TextRange.Text = " Je had tijdens deze presentatie " & Cal_B & " calorieen kunnen verbranden. Je had ook de accu van je laptop voor " & (Cal_B * 0.2) & "% kunnen opladen"
End With
End Sub

Ik vond het leuk om er wat mee te klooien en hoop dat iemand er iets aan heeft.

Dit is de werkende versie bij mij. Mogelijk moet je de standaardwaarden herstellen voor uitvoeren(alt + f11 en dan de stopknop indrukken)Bekijk bijlage Calorieenteller.rar
 
Laatst bewerkt:
U kunt het bestand comprimeren naar een zip en deze zo uploaden. Let wel op de maximale uploadgrootte :)
 
Misschien moet je even hier kijken; daar staat een voorbeeldje dat wél werkt.
 
Dat was niet een passend voorbeeld, en het werkte ook niet.

Ik heb gelukkig de oplossing gevonden, ik had de actie natuurlijk buiten de loop moeten plaatsen ipv binnen het wachtmoment van 4 seconden.
 
Het voorbeeld werkt prima, daar ligt het niet aan. Hoe ziet je uiteindelijke code er uit? Altijd wel fijn voor de lezers om de definitieve versie te kunnen uitproberen.
 
Bij mij gebeurt er niets als ik het uitvoer, maar dat maakt niet uit.

Verklaren:
Code: 
Dim Cal_B As Integer
Dim i As Integer
Dim iTime, Start As Single

Functie om elke 4 seconden een calorie te laten verbranden
Code: 
Sub cal()
    Cal_B = 0
        While Cal_B < 1000                                                  'Kan alles zijn, zolang het programma maar doorloopt
            With ActivePresentation.Slides(1).Shapes("Oval 4")
            .TextFrame.TextRange.Text = Cal_B
            iTime = 4                                                       'Tijd die je nodig hebt voordat het getal omhoog gaat
            Start = Timer                                                   'Het starten van de klok (Start krijgt de tijd in seconden sinds middernacht mee)
            Do While Timer < Start + iTime                                  'Blijf niets doen tot "iTime" verstreken is
            DoEvents
            Loop
            i = ActivePresentation.SlideShowWindow.View.CurrentShowPosition 'Controleer of presentatie nog draait en op welke dia
            If i = 1 Then                                                   'Slide 1 = doorgaan
                Cal_B = Cal_B + 1
            ElseIf i = 2 Then                                               'Slide 2 = andere functie aanroepen
                Call dus
                End
            Else
                End                                                         'Dit betekent einde van de presentatie en dus stoppen met de code
            End If
            End With
        Wend
End Sub

Functie om te code te starten wanneer slide1 opent
Code: 
Sub OnSlideShowPageChange()
    
    i = ActivePresentation.SlideShowWindow.View.CurrentShowPosition         'Het opstarten van de code in de presentatie
    If i = 1 Then
    Call cal
    End If
End Sub

Functie om wat te zeggen over het aantal aan het eind
Code: 
Sub dus()
With ActivePresentation.Slides(2).Shapes("Rectangle 9")                     'Hier wordt tekst toegevoegd aan een vorm zodat je er wat over kan vertellen
            .TextFrame.TextRange.Text = " Je had tijdens deze presentatie " & Cal_B & " calorieen kunnen verbranden. Je had ook de accu van je laptop voor " & (Cal_B * 0.2) & "% kunnen opladen"
End With
End Sub

Ik vond het leuk om er wat mee te klooien en hoop dat iemand er iets aan heeft.
 
EenTouw zei:
Bij mij gebeurt er niets als ik het uitvoer, maar dat maakt niet uit.
Klik om te vergroten...
Bedoel je daarmee dat de aanpassingen in de code die je hebt gepost niet werken? Want ik krijg jouw code ook niet aan de praat. Nu komt dat gedeeltelijk doordat de namen die je in de objecten gebruikt anders zijn dan de namen in je code, maar zelfs als je die aanpast gebeurt er bar weinig :).
 
Nee, ik bedoel dat het voorbeeldbestand uit jouw link niet werkt wanneer ik de presentatie start. Mijn code werkt wel, al kan je af en toe de standaardwaarden moeten herstellen. Waarom weet ik niet maar ik red me er wel mee.
 
Kun je jouw presentatie werkend posten? Want als ik 'm niet aan de praat krijg, vermoed ik dat meer mensen dat probleem hebben :).
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan