PDA

View Full Version : VBA wont start unless editor is opened first.



jondallimore
01-04-2013, 09:59 AM
Hi. I have the code below which should run each time the slideshow changes slides. However, the code will not run unless I first go into the VBA editor. Just opening and closing the editor makes the code run.

Is there any way to make sure the code runs when the file is loaded and the slideshow run? I dont want to have to open the VBA editor every time.

Many thanks in advance
Jon

PS, the code isnt yet complete, but if theres any suggestions for efficiency or neatness they will be gratefully received.


Sub OnSlideShowPageChange()
Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4
Dim lngStatus As Long
Dim strError As String
Dim strData As String
Dim strData2 As String
Dim Response As String
Dim Row As Integer
Dim Col As Integer
Dim Aye As Integer
Dim Bee As Integer
Dim Cee As Integer
Dim Dee As Integer
Dim All As Integer
Dim A1 As Integer
Dim A2 As Integer
Dim A3 As Integer
Dim A4 As Integer
Dim B1 As Integer
Dim B2 As Integer
Dim B3 As Integer
Dim B4 As Integer
Dim C1 As Integer
Dim C2 As Integer
Dim C3 As Integer
Dim C4 As Integer
Dim D1 As Integer
Dim D2 As Integer
Dim D3 As Integer
Dim D4 As Integer

Let Aye = 0
Let Bee = 0
Let Cee = 0
Let Dee = 0
Let All = 0

MsgBox "Working"
Let intPortID = 3
' Initialize Communications
lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), _
"baud=4800 parity=N data=8 stop=1")

COMLook:
' Read maximum of 64 bytes from serial port.
lngStatus = CommRead(intPortID, strData, 64)
If lngStatus > 0 Then
' MsgBox (strData)
ElseIf lngStatus < 0 Then
' MsgBox "Error: The COM Port is not Open"
End If


'Compare COM data to expected data - Jumpouts to Team Code

A:
If Aye = 10 Then GoTo B
If InStr(1, strData, "A", vbTextCompare) And Aye = 0 Then GoTo AA
B:
If Bee = 10 Then GoTo C
If InStr(1, strData, "B", vbTextCompare) And Bee = 0 Then GoTo BB

C:
If Cee = 10 Then GoTo D
If InStr(1, strData, "C", vbTextCompare) And Cee = 0 Then GoTo CC

D:
If Dee = 10 Then GoTo CheckAnswersIn
If InStr(1, strData, "D", vbTextCompare) And Dee = 0 Then GoTo DD

CheckAnswersIn:
'Check if all Teams have given an Answer
Let All = Aye + Bee + Cee + Dee

'If all answers are in then skip to end. Set to 10 for testing, 40 for operational use
If All = 10 Then GoTo SkipOut
GoTo COMLook

AA:
Let Aye = 10 'Prevents answer from being changed
Let Row = 2 'Set Row
Let Col = 2 'Set Column

'Ensure all cells are blank
Shapes(3).Table.Cell(Row, Col).Shape.TextFrame.TextRange.Text = ""
Shapes(3).Table.Cell(Row, Col + 1).Shape.TextFrame.TextRange.Text = ""
Shapes(3).Table.Cell(Row, Col + 2).Shape.TextFrame.TextRange.Text = ""
Shapes(3).Table.Cell(Row, Col + 3).Shape.TextFrame.TextRange.Text = ""

'Insert 8 into relevant cell - make sure all cells are font WingDings 2
If InStr(1, strData, "1", vbTextCompare) Then
Shapes(3).Table.Cell(Row, Col).Shape.TextFrame.TextRange.Text = "8"
Let A1 = 1
Let Response = "A"
' Write data to serial port.
lngSize = Len(Response)
lngStatus = CommWrite(intPortID, Response)
If lngStatus <> lngSize Then
' Handle error.
End If


If A1 = 1 Then GoTo COMLook

If InStr(1, strData, "2", vbTextCompare) Then
Shapes(3).Table.Cell(Row, Col + 1).Shape.TextFrame.TextRange.Text = "8"
Let A2 = 1
End If
If A2 = 1 Then GoTo COMLook

If InStr(1, strData, "3", vbTextCompare) Then
Shapes(3).Table.Cell(Row, Col + 2).Shape.TextFrame.TextRange.Text = "8"
Let A3 = 1
End If
If A3 = 1 Then GoTo COMLook

If InStr(1, strData, "4", vbTextCompare) Then
Shapes(3).Table.Cell(Row, Col + 3).Shape.TextFrame.TextRange.Text = "8"
Let A4 = 1
End If
If A4 = 1 Then GoTo COMLook

GoTo COMLook

BB:
Let Bee = 10
Let Row = 3
Let Col = 2

Shapes(3).Table.Cell(Row, Col).Shape.TextFrame.TextRange.Text = ""
Shapes(3).Table.Cell(Row, Col + 1).Shape.TextFrame.TextRange.Text = ""
Shapes(3).Table.Cell(Row, Col + 2).Shape.TextFrame.TextRange.Text = ""
Shapes(3).Table.Cell(Row, Col + 3).Shape.TextFrame.TextRange.Text = ""

If InStr(1, strData, "1", vbTextCompare) Then
Shapes(3).Table.Cell(Row, Col).Shape.TextFrame.TextRange.Text = "8"
Let B1 = 1
End If
If B1 = 1 Then GoTo COMLook

If InStr(1, strData, "2", vbTextCompare) Then
Shapes(3).Table.Cell(Row, Col + 1).Shape.TextFrame.TextRange.Text = "8"
Let B2 = 1
End If
If B2 = 1 Then GoTo COMLook

If InStr(1, strData, "3", vbTextCompare) Then
Shapes(3).Table.Cell(Row, Col + 2).Shape.TextFrame.TextRange.Text = "8"
Let B3 = 1
End If
If B3 = 1 Then GoTo COMLook

If InStr(1, strData, "4", vbTextCompare) Then
Shapes(3).Table.Cell(Row, Col + 3).Shape.TextFrame.TextRange.Text = "8"
Let B4 = 1
End If
If B4 = 1 Then GoTo COMLook

GoTo COMLook

CC:
Let Cee = 10
Let Row = 4
Let Col = 2

Shapes(3).Table.Cell(Row, Col).Shape.TextFrame.TextRange.Text = ""
Shapes(3).Table.Cell(Row, Col + 1).Shape.TextFrame.TextRange.Text = ""
Shapes(3).Table.Cell(Row, Col + 2).Shape.TextFrame.TextRange.Text = ""
Shapes(3).Table.Cell(Row, Col + 3).Shape.TextFrame.TextRange.Text = ""

If InStr(1, strData, "1", vbTextCompare) Then
Shapes(3).Table.Cell(Row, Col).Shape.TextFrame.TextRange.Text = "8"
Let C1 = 1
End If
If C1 = 1 Then GoTo COMLook

If InStr(1, strData, "2", vbTextCompare) Then
Shapes(3).Table.Cell(Row, Col + 1).Shape.TextFrame.TextRange.Text = "8"
Let C2 = 1
End If
If C2 = 1 Then GoTo COMLook

If InStr(1, strData, "3", vbTextCompare) Then
Shapes(3).Table.Cell(Row, Col + 2).Shape.TextFrame.TextRange.Text = "8"
Let C3 = 1
End If
If C3 = 1 Then GoTo COMLook

If InStr(1, strData, "4", vbTextCompare) Then
Shapes(3).Table.Cell(Row, Col + 3).Shape.TextFrame.TextRange.Text = "8"
Let C4 = 1
End If
If C4 = 1 Then GoTo COMLook

GoTo COMLook

DD:
Let Dee = 10
Let Row = 5
Let Col = 2

Shapes(3).Table.Cell(Row, Col).Shape.TextFrame.TextRange.Text = ""
Shapes(3).Table.Cell(Row, Col + 1).Shape.TextFrame.TextRange.Text = ""
Shapes(3).Table.Cell(Row, Col + 2).Shape.TextFrame.TextRange.Text = ""
Shapes(3).Table.Cell(Row, Col + 3).Shape.TextFrame.TextRange.Text = ""

If InStr(1, strData, "1", vbTextCompare) Then
Shapes(3).Table.Cell(Row, Col).Shape.TextFrame.TextRange.Text = "8"
Let D1 = 1
End If
If D1 = 1 Then GoTo COMLook

If InStr(1, strData, "2", vbTextCompare) Then
Shapes(3).Table.Cell(Row, Col + 1).Shape.TextFrame.TextRange.Text = "8"
Let D2 = 1
End If
If D2 = 1 Then GoTo COMLook

If InStr(1, strData, "3", vbTextCompare) Then
Shapes(3).Table.Cell(Row, Col + 2).Shape.TextFrame.TextRange.Text = "8"
Let D3 = 1
End If
If D3 = 1 Then GoTo COMLook

If InStr(1, strData, "4", vbTextCompare) Then
Shapes(3).Table.Cell(Row, Col + 3).Shape.TextFrame.TextRange.Text = "8"
Let D4 = 1
End If
If D4 = 1 Then GoTo COMLook

GoTo COMLook



'MsgBox (strData)
SkipOut:
MsgBox "All Answers In"
End If
End Sub

John Wilson
01-04-2013, 10:22 AM
OnSlideShowPageChange is a pseudoevent left over from version 97. It does not work properly in any current version and as you say once saved will not run until the vbe is accessed. You can do this by having any code run or by adding an onLoad event in the XML (see here) (http://www.pptalchemy.co.uk/PowerPoint_Run_when_show_starts.html)

To make this work properly you need to write a withevents class module - not straightforward.

Bottom line OnSlideShowPageChange is unreliable!

jondallimore
01-04-2013, 10:31 AM
hmmm.

i increasingly feel like one day i will end up simply setting fire to microsoft

thanks. I'll give that a try. Should I stop bashing my head against this brick wall when I hear a squishy noise?

jondallimore
01-04-2013, 11:50 AM
Well I've tried it and it works when the file opens, but wont work when the slideshow starts.

If theres a way to do both, that would be good, but if I had to choose, Id like it to run when the slideshow starts and on each slide. Is there a way to run the code when F5 is pressed to start the slideshow? I will always use F5, not the toolbar option

John Wilson
01-04-2013, 02:04 PM
What did you try? If you have any code run when the ribbon loads (from onLoad thern the OnSlideShowPageChangeCode should also run on each slide change.

As I said though a proper event driven AddIn is the real answer.

You might want to take this apart to see how the class works (just the basics of course)
DOWNLOAD DEMO (http://www.pptalchemy.co.uk/Downloads/Events.pptm)

jondallimore
01-05-2013, 04:59 AM
sorted it now. it works. thanks. not sure what i did wrong first time.