Consulting

Results 1 to 3 of 3

Thread: Need help with a slight modification in my VBA code

  1. #1
    VBAX Regular
    Joined
    Apr 2018
    Posts
    9
    Location

    Need help with a slight modification in my VBA code

    Hi everyone, I have a VBA code to create a countdown counter inside 4 shapes in a slide ( days, hours, minutes and seconds). I use an action button (shape) to run the macro, on mouse click.

    My code is as below:

    Public Sub Countdown()    Dim diff As Double
        Dim endDate As Date: endDate = DateSerial(2018, 11, 2)
        Dim days As Integer
        While 1
            DoEvents
            diff = endDate - Now()
            days = Int(diff)
            With ActivePresentation
                .Slides(2).Shapes(4).TextFrame.TextRange.Text = days
                .Slides(2).Shapes(6).TextFrame.TextRange.Text = Hour(diff - days)
                .Slides(2).Shapes(7).TextFrame.TextRange.Text = Minute(diff - days)
                .Slides(2).Shapes(8).TextFrame.TextRange.Text = Second(diff - days)
            End With
        Wend
    End Sub
    However, the problem is that this code will only work when the slide is in the 2nd position of the presentation. How could I modify the code such that this would work regardless of the position my slide in in the ppt? Any help would be appreciated.
    Last edited by omar23j; 07-31-2018 at 12:33 PM.

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,667
    Location
    Maybe something like:

    Public Sub Countdown()
    
    Dim diff As Double
    Dim osld As Slide
    Set osld = ActivePresentation.SlideShowWindow.View.Slide
        Dim endDate As Date: endDate = DateSerial(2018, 11, 2)
        Dim days As Integer
        While 1
            DoEvents
            diff = endDate - Now()
            days = Int(diff)
            
                osld.Shapes(4).TextFrame.TextRange.Text = days
                osld.Shapes(6).TextFrame.TextRange.Text = Hour(diff - days)
                osld.Shapes(7).TextFrame.TextRange.Text = Minute(diff - days)
                osld.Shapes(8).TextFrame.TextRange.Text = Second(diff - days)
            
        Wend
    End Sub
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Regular
    Joined
    Apr 2018
    Posts
    9
    Location
    Quote Originally Posted by John Wilson View Post
    Maybe something like:

    Public Sub Countdown()
    
    Dim diff As Double
    Dim osld As Slide
    Set osld = ActivePresentation.SlideShowWindow.View.Slide
        Dim endDate As Date: endDate = DateSerial(2018, 11, 2)
        Dim days As Integer
        While 1
            DoEvents
            diff = endDate - Now()
            days = Int(diff)
            
                osld.Shapes(4).TextFrame.TextRange.Text = days
                osld.Shapes(6).TextFrame.TextRange.Text = Hour(diff - days)
                osld.Shapes(7).TextFrame.TextRange.Text = Minute(diff - days)
                osld.Shapes(8).TextFrame.TextRange.Text = Second(diff - days)
            
        Wend
    End Sub
    thanks!!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •