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


"David M. Marcovitz" <marcoNOSPAM@xxxxxxxxxx> wrote in message
news:Xns97AE7F4BCD0C7marcoNOSPAMloyolaedu@xxxxxxxxxxxxxxxx
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 Auto_Open()
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


.

Relevant Pages

  • Re: Looping through Query to create multiple sheets in excel- Just need the loop
    ... I always get to this point and I can't figure out how to loop through ... I have put the string in the query at the bottom. ... Optional strWorkSheet As String, Optional strRange As ... Dim objXLSheet As Object 'Excel.Worksheet ...
    (microsoft.public.access.forms)
  • Re: How is this conditional able to execute?
    ... inside the loop, then each time the loop iterates then a NEW reference to ... Note that the test of returndata is not a type. ... Dim returndata As String = "" ... Not that 'Changing' is only displayed when returndata is NOT an empty string ...
    (microsoft.public.dotnet.languages.vb)
  • Re: How is this conditional able to execute?
    ... Why is this part out of the loop: ... Maybe I just don't understand the returndata = "" because of the byte array. ... How can I read the string in: ... > Dim t As Thread ...
    (microsoft.public.dotnet.languages.vb)
  • Re: How to make space between bars in a graph?
    ... To get rid of the characters I'd use a simple loop and chop them out one by ... Private Function StringFilter(Strng As String) ... Dim FilteredStrng As String, n As Integer ...
    (microsoft.public.access.modulesdaovba)
  • Re: Dynamically Update Text Box on-slide with loop (VBA)
    ... Private Declare Sub Sleep Lib "kernel32" ... Dim objSlide As Slide ... Dim sDateFile As String ...
    (microsoft.public.powerpoint)