Debugging PPT macro

W

Wei Cheng

Hello:

I am fairly new to VBA and tried to create a PPT with macro which simulates
a timer driven process, the macro just blowed up(killing the slide show
along with the Powerpoint itself) and the error message came and gone sofast
I could not capture it....Any suggestion how to debug in this kind of
situation?

Following is the VBA code that I am having problem with. Thanks and your
help is deeply appreciated-my head is banging against the wall right now.


Wei Cheng

========================================
' Declarations
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal
nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal
nIDEvent As Long) As Long
Private mlngTimerID As Long
'''''''''''''''''''''''''''''
Dim arrival(200) As Long
Dim getserv(200) As Long
Dim num As Long
Dim simultime As Long
Dim checktime As Long
Dim nextserv As Long
Dim st As Long 'Serve Time
Dim ar As Double 'arrival rate
'Dim keeprunning As Long 'run flag
Dim totaltime As Long
Dim upd As Long 'Speed
'''''''''''''''''''''''''''''

' Module code
Public Sub StartTimer(lngInterval As Long)
mlngTimerID = SetTimer(0, 0, lngInterval, AddressOf OnTimer)
End Sub

Public Sub StopTimer()
KillTimer 0, mlngTimerID
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Private Sub init()
num = 0
simultime = 0
checktime = 0
nextserv = 0
st = 0
ar = 0
'keeprunning = 0
totaltime = 0
upd = 0
End Sub

Public Sub StartSimulation()
init

'keeprunning = 1
Slide1.btnStartSimulation.Visible = False
Slide1.btnStopSimulation.Visible = True
ar = CLng(Slide1.txtArrivalRate.Text)
st = CLng(Slide1.txtServeTime.Text)
upd = CLng(Slide1.txtSpeed.Text)

'start timer here
StartTimer (upd)
End Sub

Public Sub StopSimulation()
'killtimer here
KillTimer (mlngTimerID)
End Sub

Public Sub OnTimer(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal idEvent As Long, ByVal dwTime As Long)
On Error Resume Next
Dim rn As Double

checktime = checktime + 1
''output checktime here
rn = Rnd()

If (rn < ar) Then
num = num + 1 'add a new one into the queue
'show num here
arrival [num] = checktime * 1
If (nextserv > arrive(num)) Then
getserv(num) = nextserv + st
Else 'no wait
getserve(num) = arrival(num) + st
End If
nextserv = getserv(num)
totaltime = totaltime + nextserv = arrival(num)

'output average time
'output average wait
End If
waitcalc
If (num > 200) Then
StopTimer
End If
End Sub

Private Sub waitcalc()
Dim chnum As Long
Dim waitval As Long
Dim valto As Long
Dim J As Long

chnum = 0
waitval = 0
J = num
Do While (J > 0)
If (getserv(J) > checktime) Then
waitval = waitval + 1
End If
J = J - 1
Loop
'output waitval
If (waitval > 0) Then
'show meet picture
If (waitval > 1) Then
valto = 10 - waitval
If (valto < 0) Then
valto = 0
End If
'display valto images
If valto > 0 Then
Slide1.Image2.Visible = True
Else
Slide1.Image2.Visible = False
End If
If valto > 1 Then
Slide1.Image3.Visible = True
Else
Slide1.Image3.Visible = False
End If
If valto > 2 Then
Slide1.Image4.Visible = True
Else
Slide1.Image2.Visible = False
End If
If valto > 3 Then
Slide1.Image5.Visible = True
Else
Slide1.Image5.Visible = False
End If
If valto > 4 Then
Slide1.Image6.Visible = True
Else
Slide1.Image6.Visible = False
End If
If valto > 5 Then
Slide1.Image7.Visible = True
Else
Slide1.Image7.Visible = False
End If
If valto > 6 Then
Slide1.Image8.Visible = True
Else
Slide1.Image8.Visible = False
End If
If valto > 7 Then
Slide1.Image9.Visible = True
Else
Slide1.Image9.Visible = False
End If
If valto > 8 Then
Slide1.Image10.Visible = True
Else
Slide1.Image10.Visible = False
End If
If valto > 9 Then
Slide1.Image11.Visible = True
Else
Slide1.Image11.Visible = False
End If
End If
End If
End Sub
 
S

Steve Rindsberg

Hello:

I am fairly new to VBA and tried to create a PPT with macro which simulates
a timer driven process, the macro just blowed up(killing the slide show
along with the Powerpoint itself) and the error message came and gone sofast
I could not capture it....Any suggestion how to debug in this kind of
situation?
Click to expand...

Do you need vba to do this at all?

Why not create several slides that are identical except for the image that you
want to change then apply transition times to them?

Visually, the effect will be the same, and the presentation will work even in
the free viewers that don't support VBA.
Following is the VBA code that I am having problem with. Thanks and your
help is deeply appreciated-my head is banging against the wall right now.

Wei Cheng

========================================
' Declarations
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal
nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal
nIDEvent As Long) As Long
Private mlngTimerID As Long
'''''''''''''''''''''''''''''
Dim arrival(200) As Long
Dim getserv(200) As Long
Dim num As Long
Dim simultime As Long
Dim checktime As Long
Dim nextserv As Long
Dim st As Long 'Serve Time
Dim ar As Double 'arrival rate
'Dim keeprunning As Long 'run flag
Dim totaltime As Long
Dim upd As Long 'Speed
'''''''''''''''''''''''''''''

' Module code
Public Sub StartTimer(lngInterval As Long)
mlngTimerID = SetTimer(0, 0, lngInterval, AddressOf OnTimer)
End Sub

Public Sub StopTimer()
KillTimer 0, mlngTimerID
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Sub init()
num = 0
simultime = 0
checktime = 0
nextserv = 0
st = 0
ar = 0
'keeprunning = 0
totaltime = 0
upd = 0
End Sub

Public Sub StartSimulation()
init

'keeprunning = 1
Slide1.btnStartSimulation.Visible = False
Slide1.btnStopSimulation.Visible = True
ar = CLng(Slide1.txtArrivalRate.Text)
st = CLng(Slide1.txtServeTime.Text)
upd = CLng(Slide1.txtSpeed.Text)

'start timer here
StartTimer (upd)
End Sub

Public Sub StopSimulation()
'killtimer here
KillTimer (mlngTimerID)
End Sub

Public Sub OnTimer(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal idEvent As Long, ByVal dwTime As Long)
On Error Resume Next
Dim rn As Double

checktime = checktime + 1
''output checktime here
rn = Rnd()

If (rn < ar) Then
num = num + 1 'add a new one into the queue
'show num here
arrival [num] = checktime * 1
If (nextserv > arrive(num)) Then
getserv(num) = nextserv + st
Else 'no wait
getserve(num) = arrival(num) + st
End If
nextserv = getserv(num)
totaltime = totaltime + nextserv = arrival(num)

'output average time
'output average wait
End If
waitcalc
If (num > 200) Then
StopTimer
End If
End Sub

Private Sub waitcalc()
Dim chnum As Long
Dim waitval As Long
Dim valto As Long
Dim J As Long

chnum = 0
waitval = 0
J = num
Do While (J > 0)
If (getserv(J) > checktime) Then
waitval = waitval + 1
End If
J = J - 1
Loop
'output waitval
If (waitval > 0) Then
'show meet picture
If (waitval > 1) Then
valto = 10 - waitval
If (valto < 0) Then
valto = 0
End If
'display valto images
If valto > 0 Then
Slide1.Image2.Visible = True
Else
Slide1.Image2.Visible = False
End If
If valto > 1 Then
Slide1.Image3.Visible = True
Else
Slide1.Image3.Visible = False
End If
If valto > 2 Then
Slide1.Image4.Visible = True
Else
Slide1.Image2.Visible = False
End If
If valto > 3 Then
Slide1.Image5.Visible = True
Else
Slide1.Image5.Visible = False
End If
If valto > 4 Then
Slide1.Image6.Visible = True
Else
Slide1.Image6.Visible = False
End If
If valto > 5 Then
Slide1.Image7.Visible = True
Else
Slide1.Image7.Visible = False
End If
If valto > 6 Then
Slide1.Image8.Visible = True
Else
Slide1.Image8.Visible = False
End If
If valto > 7 Then
Slide1.Image9.Visible = True
Else
Slide1.Image9.Visible = False
End If
If valto > 8 Then
Slide1.Image10.Visible = True
Else
Slide1.Image10.Visible = False
End If
If valto > 9 Then
Slide1.Image11.Visible = True
Else
Slide1.Image11.Visible = False
End If
End If
End If
End Sub
Click to expand...

--
Steve Rindsberg, PPT MVP
PPT FAQ: www.pptfaq.com
PPTools: www.pptools.com
================================================
Featured Presenter, PowerPoint Live 2004
October 10-13, San Diego, CA www.PowerPointLive.com
================================================
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Updated problematic code-removed a few typos but problem persisted 0
Word macro that can call cells out of Excel for a find and replace 0
Making a macro only work on certain files 2
Remove Identical words 0
Closing PDF file from Excel VBA (Adobe Reader, Adobe Acrobat, Browser) 0
VBA Export to PDF 0
Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0
VBA Coding Help for Beginner 0

Top