asked on

Is there a way to delay a VBA Macro without pausing Animations in Power Point?

Ok, so I'm making a Game in Power Point. The problem is that I made a gameplay loop where as the player makes choices and moves foward via slides, but some of these slides can be re-used to use less of them.

How the game works/Is structured:

The problem is that time/timing is essential to the game's core, and I can't use the Advance Slides Feature because I need the player to go back to a previous Slide after X amount of time. In fact I don't know why Microsoft didn't implemented this feature before themselves....

Photo of the feature that I'm trying to create/implement into my game:

So to send the player to X Slide after Y amount of time I've tried using functions that "Wait" before executing a macro such as:

waitTime = 3  
  
   Start = Timer    
   While Timer < Start + waitTime        
      DoEvents    

Wend

Open in new window

Function Wait(Seconds As Double) As Boolean   
    Static StartTime As Double    If StartTime = 0 Then StartTime = Timer   
    If Timer - StartTime >= Seconds Then       
        Wait = True        StartTime = 0       
    End If   
End Function

Open in new window

The problem with these functions is that they literally pause the whole Power Point Presentation(I want Animations to keep playing while the macro does it's job.), and since I'm making a Power Point Game, I don't want it to do that because it messes with the experience and the flow of the Game.

So is there a way to make a Macro or a Function that only tracks time without pausing the animations in PPT, and after X amount of time executes code? Or perhaps fusing functions and macros into one so it can ease my work?

Something like this:

Sub GameLoop() 
SlideShowWindows(1).View.GotoSlide (X) Waitfor 3
If SlideShowWindows(1).View.CurrentShowPosition = X Then
SlideShowWindows(1).View.GotoSlide (Y) 
Else
End If
End Sub

Open in new window

By the way I found useful information in the matter, although I'm not sure on how to implement those to my own functions or macros, its complicated. I will leave reference links:

https://stegriff.co.uk/upblog/non-blocking-wait-or-sleep-in-office-vba/
https://social.msdn.microsoft.com/Forums/en-US/9f6891f2-d0c4-47a6-b63f-48405aae4022/powerpoint-run-macro-on-timer?forum=isvvba

Thanks in advance!

Robert Berke

Sounds like you want a modeless user form.
It has been years since I last used one, but it worked as follows
1. the user started a macDoIt macro that processed thousands of database updates.
2. The macDoIt started by opening a "Modeless" user form named "frmMonitorProgress"
3. Since frmMonitorProgress was modeless is ran concurrently with macDoIt,
Once every minute frmMonitorProgress would update a form text box.
the form looked something like this
Records Processed 1 through 553
Process paused at record 553
Click here to Pause processing.
Click here to restart processing.
Click here to unload the form and cancel further processing.

If you think something like that would work for you I could dig up the code.

Fabrice Lambert

Well, the first link is for Excel only, it doesn't work with PowerPoint.
The second link isn't 64 bits compliant.

Maybe with more explanation an meaningfull names it will be easyer to understand.
First, create a class module, name it Timer:
(don't worry about red text)

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal TimerID As Long, ByVal Delay As Long, ByVal CallBackFunction As LongPtr) As Long
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal TimerID As Long) As Long
#Else
    Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal TimerID As Long, ByVal Delay As Long, ByVal CallBackFunction As Long) As Long
    Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal TimerID As Long) As Long
#End If

Private mDelay As Long
Private mTimerID As Long
Private mCallBackFunction As LongPtr

Friend Sub Construct(ByVal Delay As Long, CallBackFunction As LongPtr)
    mDelay = Delay
    mCallBackFunction = CallBackFunction
End Sub

Public Sub Start()
    If (mTimerID = 0) Then
        mTimerID = SetTimer(0, 0, mDelay, mCallBackFunction)
        If mTimerID = 0 Then
            Err.Raise Err.LastDllError, "Timer", "Failed to start the timer."
            Exit Sub
        End If
    End If
End Sub

Public Sub Kill()
    If (mTimerID <> 0) Then
        mTimerID = KillTimer(0, mTimerID)
        If mTimerID = 0 Then
            mTimerID = 0
            Err.Raise Err.LastDllError, "Timer", "Failed to stop the timer."
            Exit Sub
        End If
        mTimerID = 0
    End If
End Sub

Open in new window

The Timer class only have 2 member functions:
Start: It start the timer, if it is already running, it has no effect.
Kill: It stop the timer
Note that the timer will fire over and over again if not killed.

2nd, create a standard module, name it TimerFactory:

Option Explicit

Public Function Create_Timer(ByVal Delay As Long, ByVal CallBackFunction As LongPtr) As Timer
    Set Create_Timer = New Timer
    Create_Timer.Construct Delay, CallBackFunction
End Function

Open in new window

You will call Create_Timer to instanciate a Timer object.
It need 2 parameters:
Delay (in milliseconds): The delay after wich the timer will fire
CallBackFunction: The address of the function that will be executed when the timer will fire. This is given by the AddressOf operator. Also note that the function can't be a class member function.

Finally, Create a standard module (name doesn't matter), and write sample functions:
(in fact, this is all you have to worry about).

Option Explicit

Private Timer As Timer

Public Sub test()
    Set Timer = TimerFactory.Create_Timer(5000, AddressOf onTime)
    Debug.Print Now
    Timer.Start
End Sub

Private Sub onTime()
    Debug.Print "Timer fired at: " & Now
    Timer.Kill
End Sub

Open in new window

Note that the Timer instance need a module scope.

John Korchok

Give this a try. Declare Sleep at the top of your module:

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

Open in new window

Then call it with this statement in your code:

Sleep 1000

Open in new window

The number after Sleep is milliseconds, so this offers fine control.

Fabrice Lambert

@John:
Alas, the Sleep function is blocking.

Jorge Coronel

ASKER

@John Korchok

The Sleep function is useful, but the problem is that it stops the presentation completely for the Sleep X amount of time. Meaning Animations do not play. Still thank You a lot.

Jorge Coronel

ASKER

@Fabrice Lambert

It seems like it could work... I need to check first hand, let me give it a try and I will keep You updated in the matter.

Jorge Coronel

ASKER

@rberke

Maybe I don't get the full picture because I'm not so good at VBA, but that method seems a little bit complicated and more for Data Bases or programs of sorts. Is there a way to strictly track down time without pausing the presentation?

For example a function that only counts X amount of time. That Way I can use the function to count up to X time, and then execute the subsequent code.

Jorge Coronel

ASKER

@Fabrice Lambert

The functions and macro that You suggested are amazing honestly, they don't pause the Presentation, animations run smoothly and everything works just fine and honestly, Thank You a lot for sharing it with Me. But I only have two more questions:

1.- I can't use Cases on the onTime Macro, because for some reason it soft-locks/soft-crashes Power Point, is there a way to use Case's without it crashing?

2.- If I decide to use a If/Else Which would be the best way to do it without slowing down the code? Because I will need to use a lot of If/Elses's. And I don't want to have Spaghetti code.

Also from what I tested, it's really important that if You add another function, You always have to add the Timer.Kill otherwise it leads to errors and crashes.

So, any suggestions on how to improve the Case/Else.If problem?

User generated image

Actual is a function of mine and it goes as follows:

Public Function Actual() As Integer
Actual = SlideShowWindows(1).View.CurrentShowPosition
End Function

Open in new window

Other than that, Your solution worked, thanks a lot.

Fabrice Lambert

Use multiple timers and multiple event handlers if possible.

Having a single event handler handling everything isn't a good approach.

Jorge Coronel

ASKER

@Fabrice Lambert

You're totally right! I tried doing so and it works but only half way, Sub test1() does it's job but Sub onTime1 doesn't, instead Sub onTime activates... Could You point out, what I'm doing wrong? I'm sorry if I missed something so simple, I'm still learning and I tend to overlook stuff.

Option Explicit


Private Timer As Timer


Public Sub test()
    Set Timer = TimerFactory.Create_Timer(2000, AddressOf onTime)
    Debug.Print Now
    MsgBox ("Start")
    Timer.Start
End Sub


Private Sub onTime()
If Actual = 2 Then
    Debug.Print "Timer fired at: " & Now
    MsgBox ("Finished")
    Timer.Kill
    Else
    Debug.Print "Timer fired at: " & Now
    MsgBox ("You're not in the first Slide")
    Timer.Kill
    End If
End Sub


Public Sub TestLoop()
    Set Timer = TimerFactory.Create_Timer(3000, AddressOf onTime)
    Debug.Print Now
    SlideShowWindows(1).View.GotoSlide (8)
    Timer.Start
End Sub


Option Explicit


Private Timer As Timer1


Public Sub test1()
    Set Timer = TimerFactory.Create_Timer(3000, AddressOf onTime)
    Debug.Print Now
    MsgBox ("Start_1")
    Timer.Start
End Sub


Private Sub onTime1()
If Actual = 1 Then
    Debug.Print "Timer fired at: " & Now
    MsgBox ("Finished_1")
    Timer.Kill1
    Else
    Debug.Print "Timer fired at: " & Now
    MsgBox ("You're not in the first Slide_1")
    Timer.Kill1
    End If
End Sub

Open in new window

ASKER CERTIFIED SOLUTION

Fabrice Lambert

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Jorge Coronel

ASKER

Thank You so much! I'm a beginner and very distracted at that, this macro was giving me such a hard time and You completely erased that problem, seriously You're the best!