Announcement

Collapse
No announcement yet.

PowerPoint Macro; Continually Run

Collapse
This topic is closed.
X
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • PowerPoint Macro; Continually Run



    Hi All,

    I'm running a Macro in PowerPoint (A countdown), that I want to update every second while the presentation is being run.

    Where do I have to put the code to initiate the macro and what syntax do I have to use to get the loop to happen every second (Application.Wait doesn't seem to be avaiable in PPt).

    Here's the code so far...

    Code:
    Private Sub UPdateCLock()
    
    Dim DaysY As Double, DaysZ As Double
    Dim HoursX As Double, HoursY As Double, HoursZ As Double
    Dim MinsX As Double, MinsY As Double, MinsZ As Double
    Dim SecsX As Double, SecsY As Double, SecsZ As Double
    
    Do
    
    DaysY = (34969875 / 900) - Now
    
    DaysZ = Round(DaysY - 0.5, 0)
    
    HoursX = DaysY - DaysZ
    HoursY = HoursX * 24
    HoursZ = Round(HoursY - 0.5, 0)
    
    MinsX = HoursY - HoursZ
    MinsY = MinsX * 60
    MinsZ = Round(MinsY - 0.5, 0)
    
    SecsX = MinsY - MinsZ
    SecsY = SecsX * 60
    SecsZ = Round(SecsY, 0)
    
    Shapes("TextBox1").OLEFormat.Object.Text = DaysZ & " Dys " & HoursZ & " Hrs " _
    & MinsZ & " Mins " & SecsZ & " Secs until the Spring Conference"
    
    DoEvents
    
    Loop
    End Sub
    Any help appreciated, this my first Macro outside of Excel...

    Thanks,
    Ian

  • #2
    Re: PowerPoint Macro; Continually Run

    Hi Ian,

    I am taking a look at your problem and will get back to you when I have a solution. I assume you want the timer to run during the slide show.

    I don't spend much time in this forum so please drop me an email via my website:
    www.bettersolutions.com

    I will then be able to send you the solution.

    regards
    Russell

    Comment


    • #3
      Re: PowerPoint Macro; Continually Run

      Hi,

      You could try this. Place the textbox on the slidemaster.
      Add a class module called Class1
      Public WithEvents MyApp As Application

      Private Sub MyApp_SlideShowBegin(ByVal Wn As SlideShowWindow)

      g_blnRunning = True
      UPdateCLock

      End Sub
      Private Sub MyApp_SlideShowEnd(ByVal Pres As Presentation)

      g_blnRunning = False

      End Sub
      Private Sub MyApp_SlideShowNextSlide(ByVal Wn As SlideShowWindow)
      UPdateCLock
      End Sub
      Standard code module
      Option Explicit

      Public g_blnRunning As Boolean
      Public g_clsApp As Class1

      Sub Start()

      If g_clsApp Is Nothing Then
      Set g_clsApp = New Class1
      Set g_clsApp.MyApp = Application
      End If
      g_blnRunning = True
      ActivePresentation.SlideShowSettings.Run
      UPdateCLock
      End Sub

      Public Sub UPdateCLock()

      Dim DaysY As Double, DaysZ As Double
      Dim HoursX As Double, HoursY As Double, HoursZ As Double
      Dim MinsX As Double, MinsY As Double, MinsZ As Double
      Dim SecsX As Double, SecsY As Double, SecsZ As Double

      Do While g_blnRunning
      DaysY = (34969875 / 900) - Now

      DaysZ = Round(DaysY - 0.5, 0)

      HoursX = DaysY - DaysZ
      HoursY = HoursX * 24
      HoursZ = Round(HoursY - 0.5, 0)

      MinsX = HoursY - HoursZ
      MinsY = MinsX * 60
      MinsZ = Round(MinsY - 0.5, 0)

      SecsX = MinsY - MinsZ
      SecsY = SecsX * 60
      SecsZ = Round(SecsY, 0)

      ActivePresentation.SlideMaster.Shapes("TextBox1").OLEFormat.Object.Text = DaysZ & " Days " & HoursZ & " Hrs " _
      & MinsZ & " Mins " & SecsZ & " Secs until the Spring Conference"
      DoEvents
      Loop

      End Sub
      Start the presentation by running the macro Startup.
      Attached Files

      Cheers
      Andy

      Comment


      • #4


        Re: PowerPoint Macro; Continually Run

        Nice solution Andy.

        I will have to be quicker next time

        Comment

        Working...
        X