Dynamically Update Text Box on-slide with loop (VBA)

[Yogi_Bear_79]

With the help of the AutoEvents PPA I have designed a slide show that will
display a countdown clock. Basically, it reads a text file and displays the
amount of time remaining until the date/time in the text file. The original
design allowed a single slide to be displayed with a one-second advance
time. Thus the effect of counting down every second. A second use of the
slide is to insert it into a large show, and whenever the slide appears it
displays the time remaining.

I wanted to add a new feature for when the slide is displayed in a larger
show. For example, say the countdown slide is shown for 5 seconds on a
larger show. I would like the slide to countdown during those 5 seconds. To
do this, on the Sub Autpen() I capture into a global variable the
AdvanceTime of the slide in question. I've included the basic framework
(for brevity) of my module. In the Auto_NextSlide sub you will see my
For/Next loop. I have toyed with a Do While, and a Do Until. None of them
work as expected. I can get a MsgBox to appear for each iteration of the
loop, but that is about it.

I'm starting to think, that I really can not update the textbox on this
slide once it has been updated upon the slides appearance. If that is the
case, the only other way I can think of is to add, say 5 slides into my
slide show, with one second advance times. To give the appearance in a
larger show that it is counting down down.

My plan was then to add a loop in my Sub Auto_NextSlide().

Sub Autpen()
Dim objSlide As Object

For Each objSlide In ActivePresentation.Slides
If (objSlide.SlideNumber = iSlide) Then
iAdvanceTime = objSlide.SlideShowTransition.AdvanceTime
End If
Next objSlide
End Sub

Sub Auto_NextSlide(Index As Long)

' Declare variables
.............
' Initialize variables
.......................

If (Index = iSlide) Then
For i = 1 to iAdvanceTime

'Do Stuff to build the strDiff variable

' Display the String
With
ActivePresentation.Slides(iSlide).Shapes("TextBox1")
.TextFrame.TextRange.Text = strDiff
End With
Sleep 1000
i = i+1
Next
End If
End Sub

 

[David M. Marcovitz]

Assuming the strdiff variable is updated properly (and I assume you have
verified this with your MsgBox that you put in the loop) and your text
box is really named "TextBox1", this looks like it could work. Check to
see if your screen is refreshing. That is, is the text in the box being
changed and just not displayed (look at it when you exit the slide show
to see if it is updated). If that is the case, you might want to go to
the slide (ActivePresentation.SlideShowWindow.View.GotoSlide iSlide). If
it is not being updated at all, a mistake in any of the things we can't
see (misnamed text box, strDiff not really being the right thing, etc.)
could cause this. Also, I have never used the Sleep procedure. I do
delays with something like Example 8.4 on my site
(http://www.PowerfulPowerPoint.com/). That doesn't mean that Sleep
doesn't work; there is a lot of stuff I have never used in VBA, but you
might try my method of delaying if nothing else seems to be helping.
--David

--
David M. Marcovitz
Microsoft PowerPoint MVP
Director of Graduate Programs in Educational Technology
Loyola College in Maryland
Author of _Powerful PowerPoint for Educators_
http://www.PowerfulPowerPoint.com/

 

[Yogi_Bear_79]

Assuming the strdiff variable is updated properly (and I assume you have
verified this with your MsgBox that you put in the loop) and your text
box is really named "TextBox1", this looks like it could work. Check to
see if your screen is refreshing. That is, is the text in the box being
changed and just not displayed (look at it when you exit the slide show
to see if it is updated). If that is the case, you might want to go to
the slide (ActivePresentation.SlideShowWindow.View.GotoSlide iSlide). If
it is not being updated at all, a mistake in any of the things we can't
see (misnamed text box, strDiff not really being the right thing, etc.)
could cause this. Also, I have never used the Sleep procedure. I do
delays with something like Example 8.4 on my site
(http://www.PowerfulPowerPoint.com/). That doesn't mean that Sleep
doesn't work; there is a lot of stuff I have never used in VBA, but you
might try my method of delaying if nothing else seems to be helping.
--David

--
David M. Marcovitz
Microsoft PowerPoint MVP
Director of Graduate Programs in Educational Technology
Loyola College in Maryland
Author of _Powerful PowerPoint for Educators_
http://www.PowerfulPowerPoint.com/

Ok, for lack of a better idea, I am posting the entire module here: I
checked and strDiff does not get updated during the loop. Without the loop
the slide works fine, everytime the slide is displayed strDiff shows the
remaining time. So if you had a show with one-slide with an Advance time of
1 second, and removed the For Next loop, it would work. I have been using it
that way for a week or so. It also works when displayed in a larger show,
except for example, on my show it sits for 3 seconds, but while sitting
there it doesn't update. That's what the loop was for.

I agree on the sleep, generally bad...will look at your method IF this
actualy works

Option Explicit

'Declare Public Variables
Public iAdvanceTime As Integer

'Initialize Global Constants
Const iSlide = 1 '<------ This is the slide number your countdown appears
on, change as needed
Const FOR_READING = 1

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


' ***RollingShow CountDown v1.0.1***
'
'
' Created: April 13, 2006
' Modified April 22, 2006
'
' Purpose: Display a countdown until a specified date/time
'
' Useage: Can be used stand-alone, or added into an exisitng show. See
ReadMe file for instructions.
'
' Requirements: AutoEvents Add-in, ds_digital font, Trusted Access to Visual
Basic enabled, Security = Medium
'
'---------------------------------------------------------------

Sub Autpen()
Dim objSlide As Object

' Loop thru all the slides in the active presentation and return the
Advace Time of the countdown slide
' As indicated in the Global Const iSlide
For Each objSlide In ActivePresentation.Slides
If (objSlide.SlideNumber = iSlide) Then
iAdvanceTime = objSlide.SlideShowTransition.AdvanceTime
End If
Next objSlide
End Sub

Sub Auto_NextSlide(Index As Long)

' Declare variables
Dim EventDate As Date, curDate As Date
Dim days As Integer, hours As Integer, minutes As Integer, seconds As
Integer, i As Integer
Dim sDateFile As String
Dim sSeconds As String, sMinutes As String, sDays As String, sHours As
String, strDiff As String
Dim objFSO As Object, objTextStream As Object

' Initialize variables
curDate = Now()
sDateFile = "CountDown_DateFile.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")

' The countdown runs when the current slide equals iSlide
If (Index = iSlide) Then
' Open test file read date. By opening/closing everytime the slide
is presented. The time can be updated
' while the slide show is running. Just edit and save the text file
then next time the slide is displayed
' it will be based off of the updated changes
If objFSO.FileExists(sDateFile) Then ' Verify the file exists
Set objTextStream = objFSO.OpenTextFile(sDateFile, FOR_READING)

Do Until objTextStream.AtEndOfStream
EventDate = objTextStream.ReadLine
Loop

objTextStream.Close 'Close the text file
Else
' File not found do something
End If

For i = 1 To iAdvanceTime

days = Day(EventDate) - Day(curDate)
hours = Hour(EventDate) - Hour(curDate)
minutes = Minute(EventDate) - Minute(curDate)
seconds = Second(EventDate) - Second(curDate)

' Calculate days
days = IIf(hours <= 0, days - 1, days)
sDays = IIf(days = 1, " Day, ", " Days, ") ' Use singular versus
plural when applicable

' Calculate hours
hours = IIf(hours <= 0, hours + 24, hours)
hours = IIf(minutes <= 0, hours - 1, hours)
sHours = IIf(hours = 1, " Hour, ", " Hours, ") ' Use singular versus
plural when applicable

' Calculate minutes
minutes = IIf(minutes <= 0, minutes + 59, minutes)
sMinutes = IIf(minutes = 1, " Minute, ", " Minutes, ") ' Use
singular versus plural when applicable

' Calculate seconds
seconds = IIf(seconds <= 0, seconds + 59, seconds)
sSeconds = IIf(seconds = 1, " Second", " Seconds") ' Use singular
versus plural when applicable

' Build display string, remove Days, &/or Hours if they are no
longer needed
If (days <= 0) Then
If (hours <= 0) Then
strDiff = minutes & sMinutes & seconds & sSeconds
Else
strDiff = hours & sHours & minutes & sMinutes & seconds &
sSeconds
End If
Else
If (hours <= 0) Then
strDiff = days & sDays & minutes & sMinutes & seconds &
sSeconds
Else
strDiff = days & sDays & hours & sHours & minutes & sMinutes
& seconds & sSeconds
End If

End If

' Display the String
With ActivePresentation.Slides(iSlide).Shapes("TextBox1")
.TextFrame.TextRange.Text = strDiff
End With

Next
End If
End Sub

Function IIf(Condition, TrueValue, FalseValue)
If Condition Then
IIf = TrueValue
Else
IIf = FalseValue
End If
End Function

Sub NameIt()
Dim sResponse As String

With ActiveWindow.Selection.ShapeRange(1)
sResponse = InputBox("Rename this shape to ...", "Rename Shape",
..Name)
Select Case sResponse
' blank names not allowed
Case Is = ""
Exit Sub
' no change?
Case Is = .Name
Exit Sub
Case Else
On Error Resume Next
.Name = sResponse
If Err.Number <> 0 Then
MsgBox "Unable to rename this shape"
End If
End Select
End With

End Sub

 

[Bill Dilworth]

First, read up on creating an event trap. There is no Auto_NextSlide, or do
you trap the next slide event elsewhere and send it here?
**Make PPT respond to events
http://www.pptfaq.com/FAQ00004.htm

Second, if you use the 'Goto same-slide' Screen updating method, it will
create a next slide event for each refresh and the show will endless-loop /
crash. Instead, just insert a DoEvents line after you change the text in
TextBox1.


--
Bill Dilworth
A proud member of the Microsoft PPT MVP Team
Users helping fellow users.
http://billdilworth.mvps.org
-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
vestprog2@ Please read the PowerPoint FAQ pages.
yahoo. They answer most of our questions.
com www.pptfaq.com
..

 

[Yogi_Bear_79]

First, read up on creating an event trap. There is no Auto_NextSlide, or

do you trap the next slide event elsewhere and send it here?
**Make PPT respond to events
http://www.pptfaq.com/FAQ00004.htm

Second, if you use the 'Goto same-slide' Screen updating method, it will
create a next slide event for each refresh and the show will endless-loop
/ crash. Instead, just insert a DoEvents line after you change the text
in TextBox1.

Bill Dilworth

Bill,

Thanks for the response. I am using the AutoEvents add-in
http://www.mvps.org/skp/aevents.htm which does contain the Auto_NextSlide.
With that said I believe there is no need for an event trap? I'm not sure I
follow your 'Goto Same-Slide' statement. If you remove the For-Next loop my
code works perfectly, during the following scenarios.

1. A single slide set to loop continuously, with a 1 second Advance Time
2. In a larger slide show. It will display the remaining time when the
slide first appears, it will remain static while that slide is shown, and
update the next time it is shown.

My plan was for scenario two. In my current show, I use this slide as one
of about 50. It stays visible for 3 seconds. I would like it to countdown
3-seconds while it is being displayed. To do this I captured my target
slides AdvaceTime when the slide show opened, and stored it in a public
variable. I wanted to use that variable to control a loop when my target
slide is displayed. My thought was that each iteration of the loop would
cause the currently displayed text-box to update. Unfortunately it doesn't.

Plan B: instead of showing one slide for 3 seconds, show 3 slides for 1
second each and create the same illusion.

 

[Bill Dilworth]

1) Using the second party event trap is good, but creates a problem of its
own. Any error in the code will cause it to stop functioning. Sometimes it
becomes difficult to tell which part isn't functioning.

2) Really, try inserting the DoEvents command after you change the text in
the textbox1.

Bill

 

[Yogi_Bear_79]

1) Using the second party event trap is good, but creates a problem of its
own. Any error in the code will cause it to stop functioning. Sometimes
it becomes difficult to tell which part isn't functioning.

2) Really, try inserting the DoEvents command after you change the text in
the textbox1.

Bill

Ok, i tried DoEvents nothing changed. I tried it with/without a loop. Same
results either way. I'm begining to suspect you simply can not update the
text on a displayed slide via a loop. I can update the text when it opens,
but that appears to be about it. I do not believe there are any errors in
the AutoEvent PPA, as it is doing what it is intedned to do. What I am
trying to do happens after AutoEvents does it's thing

 

[Bill Dilworth]

Good, now you need to tell the code to reiterate after 1 second.

There are a couple of ways to do this.

1. Use the sleep option (best in this case, I believe) to loop the code
three times
**Put your macro to Sleep
http://www.pptfaq.com/FAQ00466.htm
'In preamble
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sleep 1000 'In sub routine
If IterationCount < 3 then
IterationCount= IterationCount+1
goto Begining
end if

2. Use a do until loop to kill 1 second, then loop three times
itime = Int(Timer)
Do Until itime <> Int(Timer)
DoEvents
Loop
If IterationCount < 3 then
IterationCount= IterationCount+1
goto Begining
end if

3. Contantly have it refresh until the time on slide expires

If SlideShowWindows(1).View.SlideElapsedTime < 4 Then GoTo BeginningOfMacro



This get it done?

Bill

 

[Yogi_Bear_79]

Bill,

One of us is confused, at least I am. The code has always worked. Please
see first post. What has not worked and still does not isthe original
question. I have tried various loops all of which work as far as the loop
goes. I can test to see if my loops are looping by adding a MsgBox that pops
up on each iteration. What does not happen is strDiff will not update on
the loops. Sleep isn't a problem, there is more than one way to solve the
sleep problem. For testing I did a simple Sleep 1000. I am succesfully
capturing the slides AdvaceTime. The loops I have tested do loop the
appropriate times. The only thing that doesn't work is the time displayed in
the textbox only changes when the slide advances. So with a 5 second Advance
time the slide updates every 5 seconds.

 

[Bill Dilworth]

This works for me, how 'bout you?


===Start Code====
Option Explicit

'Initialize Global Constants
Const FOR_READING = 1
Const TextBoxName = "MyCountdownTextBox"

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)




Sub Auto_NextSlide(Index As Long)
Dim objSlide As Slide
Dim oShp As Shape
Dim iAdvanceTime As Single
Dim iSlide As Integer

' This detects if the slide has an auto time box on it and if it does
....
iAdvanceTime = -1
iSlide = SlideShowWindows(1).View.CurrentShowPosition
Set objSlide = ActivePresentation.Slides(iSlide)

For Each oShp In objSlide.Shapes
If oShp.Name = TextBoxName Then iAdvanceTime =
objSlide.SlideShowTransition.AdvanceTime
Next oShp

If iAdvanceTime = -1 Then Exit Sub ' No shape with countdown
If objSlide.SlideShowTransition.AdvanceOnTime = False then iAdvanceTime
= 5 ' default advance time



' Declare variables
Dim EventDate As Date, curDate As Date
Dim days As Integer, hours As Integer, minutes As Integer, seconds As
Integer, i As Integer
Dim sDateFile As String
Dim sSeconds As String, sMinutes As String, sDays As String, sHours As
String, strDiff As String
Dim objFSO As Object, objTextStream As Object
Dim IterationCount As Integer


' Initialize variables
sDateFile = "CountDown_DateFile.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")

' The countdown runs when the current slide equals iSlide

' Open test file read date. By opening/closing everytime the slide
is presented. The time can be updated
' while the slide show is running. Just edit and save the text file
then next time the slide is displayed
' it will be based off of the updated changes
If objFSO.FileExists(sDateFile) Then ' Verify the file exists
Set objTextStream = objFSO.OpenTextFile(sDateFile, FOR_READING)

Do Until objTextStream.AtEndOfStream
EventDate = objTextStream.ReadLine
Loop

objTextStream.Close 'Close the text file
GoTo Begining
Else
'
End If




Begining:
curDate = Now()



days = Day(EventDate) - Day(curDate)
hours = Hour(EventDate) - Hour(curDate)
minutes = Minute(EventDate) - Minute(curDate)
seconds = Second(EventDate) - Second(curDate)

' Calculate days
days = IIf(hours <= 0, days - 1, days)
sDays = IIf(days = 1, " Day, ", " Days, ") ' Use singular versus plural
when applicable

' Calculate hours
hours = IIf(hours <= 0, hours + 24, hours)
hours = IIf(minutes <= 0, hours - 1, hours)
sHours = IIf(hours = 1, " Hour, ", " Hours, ") ' Use singular versus
plural when applicable

' Calculate minutes
minutes = IIf(minutes <= 0, minutes + 59, minutes)
sMinutes = IIf(minutes = 1, " Minute, ", " Minutes, ") ' Use singular
versus plural when applicable

' Calculate seconds
seconds = IIf(seconds <= 0, seconds + 59, seconds)
sSeconds = IIf(seconds = 1, " Second", " Seconds") ' Use singular versus
plural when applicable

' Build display string, remove Days, &/or Hours if they are no longer
needed
If (days <= 0) Then
If (hours <= 0) Then
strDiff = minutes & sMinutes & seconds & sSeconds
Else
strDiff = hours & sHours & minutes & sMinutes & seconds &
sSeconds
End If
Else
If (hours <= 0) Then
strDiff = days & sDays & minutes & sMinutes & seconds & sSeconds
Else
strDiff = days & sDays & hours & sHours & minutes & sMinutes &
seconds & sSeconds
End If

End If

' Display the String
With ActivePresentation.Slides(iSlide).Shapes(TextBoxName)
.TextFrame.TextRange.Text = strDiff
DoEvents
End With

Sleep 1000 'In sub routine

If IterationCount < iAdvanceTime Then
IterationCount = IterationCount + 1
GoTo Begining
End If

SlideShowWindows(1).View.Next

End Sub

Function IIf(Condition, TrueValue, FalseValue)
If Condition Then
IIf = TrueValue
Else
IIf = FalseValue
End If
End Function

Sub NameIt()
Dim sResponse As String

With ActiveWindow.Selection.ShapeRange(1)
sResponse = InputBox("Rename this shape to ... (" & TextBoxName & ")
to use coutdown in this box", "Rename Shape", .Name)
Select Case sResponse
' blank names not allowed
Case Is = ""
Exit Sub
' no change?
Case Is = .Name
Exit Sub
Case Else
On Error Resume Next
.Name = sResponse
If Err.Number <> 0 Then
MsgBox "Unable to rename this shape"
End If
End Select
End With

End Sub

=====EndCode=====


--
Bill Dilworth
A proud member of the Microsoft PPT MVP Team
Users helping fellow users.
http://billdilworth.mvps.org
-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
yahoo2@ Please read the PowerPoint FAQ pages.
yahoo. They answer most of our questions.
com www.pptfaq.com
..

 

[Yogi_Bear_79]

This works for me, how 'bout you?

Well on intial testing no. I renamed my text box to the variable name you
indicated. Actually thus far the slide show does nothing. Previously it
updated every timethe slide transitioned. You changed quite a few things,
So I am going thru your changes to see what is different. If there is
something you think I obviously missed, let me know

 

[Yogi_Bear_79]

"Bill Dilworth" - This works for me, how 'bout you?


Ok, I studied your code at length. From what I can tell you removed one of
my subs and incorporated a version of that sub into my Auto_NextSlide(). I
noticed an IF statement was removed. The real meat of you solution appears
to be a Goto Loop. With a counter. I tried your version in my code, along
with various other looping techniques. One thing I noticed is that, with
the Goto loop the program is doesn't respond to an ESC to end the slide
show.

I copied your entire code and replaced my module and got no results.

I'm just not sure what to say. You said it worked for you, but I can't get
it to work any different/better than I had it.

I'm still game to test/play if you are, if not I understand

 

[Bill Dilworth]

Obviously, you will need to fix all the text wrap from the newsgroup
posting. I manually triggered the macro from a previous slide, since I do
not have the event add-in loaded that you use (advance to next slide then
run the Auto_NextSlideMacro).

1) It will work on any slide that has a text box labeled
"MyCountdownTextBox" or whatever you set Const TextBoxName to be.

2) It will pull from the AutoAdvance time of that slide, if available, or
default to 5 seconds.

3) In my test, I did not use your file storage stuff. I just gave it a
dummy value for EventDate of "4/30/2006 3:00:00 PM ". It counted down for
the correct number of seconds and advanced to the next slide.

Send me an email at the address in my signature and I'll send you the test
file I used.

--
Bill Dilworth
A proud member of the Microsoft PPT MVP Team
Users helping fellow users.
http://billdilworth.mvps.org
-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
yahoo2@ Please read the PowerPoint FAQ pages.
yahoo. They answer most of our questions.
com www.pptfaq.com
..