Odd behaviour - running program without clicking on code

[tiredofit]

I have recently come across a program whereby if I merely hover the mouse over a particular line of code, the program runs.

Has anyone come across such odd behaviour?

 

[MARK858]

You can do that with jQuery in a browser if that is what you mean.

 

[tiredofit]

You can do that with jQuery in a browser if that is what you mean.

No I don't think I mean jQuery.


This program was taken from a training website.

It consists of three classes and a standard module.

ClsGame:

Option Explicit

Const MaxGuesses As Integer = 10

Public StopGameStatus As enumStopGameStatus
Private HangmanBook As Workbook

Private pWordToGuess As String
Property Get WordToGuess() As String

WordToGuess = pWordToGuess

End Property

Property Let WordToGuess(ThisGuessWord As String)
   
pWordToGuess = ThisGuessWord

Dim WordCount As Integer
WordCount = Len(pWordToGuess)


Range(Cells(1, 1), Cells(1, WordCount)).Name = "Word"
Range(Cells(1, WordCount + 1), Range("A1").End(xlToRight)).EntireColumn.Hidden = True
Range(Cells(8, 1), Cells(8, 1).End(xlDown)).EntireRow.Hidden = True

With Range("Word")

.EntireRow.RowHeight = 40

.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter

.Font.Bold = True
.Interior.Color = RGB(240, 240, 240)

End With

Dim c As Range

For Each c In Range("Word").Cells

With c
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeLeft).LineStyle = xlContinuous

.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeTop).LineStyle = xlContinuous

.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlEdgeRight).LineStyle = xlContinuous

.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeBottom).LineStyle = xlContinuous

.EntireColumn.ColumnWidth = 15

End With

Next c

Range("B3").Value = "Correct"
Range("B4").Value = "Wrong"
Range("B5").Value = "Left"

Range("A3").Name = "Correct"
Range("A4").Name = "Wrong"
Range("A5").Name = "Left"

Range("C3").Name = "GuessesCorrect"
Range("C4").Name = "GuessesWrong"
Range("C5").Name = "GuessesLeft"

Dim SpacedAlphabet As String
Dim LetterPosition As Integer

SpacedAlphabet = ""
For LetterPosition = 1 To Len(Alphabet)
SpacedAlphabet = SpacedAlphabet & Mid(Alphabet, LetterPosition, 1) & " "
Next LetterPosition
Range("GuessesLeft").Value = SpacedAlphabet

Range("Correct").Value = 0
Range("Wrong").Value = 0
Range("Left").Value = MaxGuesses

End Property

Private Sub Class_Initialize()
 
Set HangmanBook = Workbooks.Add

StopGameStatus = GameInProgress

Dim ws As Worksheet

For Each ws In Worksheets
If ws.Name <> ActiveSheet.Name Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next ws

ActiveSheet.Name = "Hangman"

End Sub

Private Sub Class_Terminate()
  
    HangmanBook.Close savechanges:=False

End Sub

Private Sub RemoveLetter(WhichLetter As String)
  
    Range("GuessesLeft").Value = Replace(Range("GuessesLeft").Value, " " & WhichLetter, "")

End Sub

Sub PlayRound()

Dim Letter As New clsGuess

Letter.CorrectWord = pWordToGuess

If Not Letter.IfTooManyGoes Then

StopGameStatus = UserKeptGuessingInvalidLetters

Exit Sub

End If

If Letter.IfAlreadyGuessed Then

MsgBox "You've already guessed this letter!"

Exit Sub

End If

RemoveLetter Letter.LetterGuessed

If Letter.IfGuessCorrect Then

Range("GuessesCorrect").Value = Range("GuessesCorrect").Value & " " & Letter.LetterGuessed
Range("Correct").Value = Range("Correct").Value + 1

If IfWordGuessed Then
StopGameStatus = UserWon
Exit Sub
End If

MsgBox "Good guess! Letter " & Letter.LetterGuessed & " was in the word.", vbOKOnly + vbExclamation, "Correct guess"

Else

Range("GuessesWrong").Value = Range("GuessesWrong").Value & " " & Letter.LetterGuessed
Range("Wrong").Value = Range("Wrong").Value + 1
Range("Left") = Range("Left").Value - 1

If Range("Left").Value = 0 Then

StopGameStatus = UserLost

Exit Sub

End If

MsgBox "Sorry: letter " & Letter.LetterGuessed & " is not in the word.", vbOKOnly + vbExclamation, "Wrong guess"

End If

End Sub

Private Function IfWordGuessed() As Boolean
   
Dim c As Range

For Each c In Range("Word")

If c.Value = "" Then
IfWordGuessed = False
Exit Function
End If

Next c

IfWordGuessed = True

End Function

ClsGuess:

Option Explicit

Public LetterGuessed As String
Public CorrectWord As String

Private Sub Class_Initialize()

LetterGuessed = ""

End Sub

Public Property Get IfTooManyGoes() As Boolean
  
If LetterGuessed = "" Then StartGuess

IfTooManyGoes = (LetterGuessed <> "")

End Property

Private Sub StartGuess()

Dim Letter As String

Const MaxGuesses As Integer = 3

Dim GuessNumber As Integer

GuessNumber = 1
LetterGuessed = ""

Do Until Len(LetterGuessed) > 0 Or GuessNumber > MaxGuesses

Letter = UCase(InputBox("Think of a letter", _
"Guess", "Type letter here"))

If Len(Letter) <> 1 Then
MsgBox "You must type in one (and only one) letter"
ElseIf InStr(1, Alphabet, Letter) <= 0 Then
MsgBox "Not a valid letter"
Else

LetterGuessed = Letter

End If

GuessNumber = GuessNumber + 1

Loop

End Sub

Property Get IfAlreadyGuessed() As Boolean

    Dim i As Integer
Dim GuessesSoFar As String

GuessesSoFar = Range("GuessesCorrect").Value & Range("GuessesWrong").Value
GuessesSoFar = Replace(GuessesSoFar, " ", "")

For i = 1 To Len(GuessesSoFar)

If Mid(GuessesSoFar, i, 1) = LetterGuessed Then
IfAlreadyGuessed = True
Exit Property
End If

Next i

IfAlreadyGuessed = False

End Property

Property Get IfGuessCorrect() As Boolean

IfGuessCorrect = False

Dim i As Integer
Dim c As Range

For i = 1 To Len(CorrectWord)

If Mid(CorrectWord, i, 1) = LetterGuessed Then

Set c = Cells(1, i)
c.Interior.Color = RGB(240, 255, 255)
c.Value = LetterGuessed
IfGuessCorrect = True

End If

Next i

End Property

ClsWord:

Option Explicit
Public WordChosen As String
Private Sub Class_Initialize()
  
Dim PossibleWords(9) As String

PossibleWords(0) = "one"
PossibleWords(1) = "two"
PossibleWords(2) = "three"
PossibleWords(3) = "four"
PossibleWords(4) = "five"
PossibleWords(5) = "six"
PossibleWords(6) = "seven"
PossibleWords(7) = "eight"
PossibleWords(8) = "nine"
PossibleWords(9) = "ten"


Dim wordNumber As Integer
wordNumber = Int(Math.Rnd() * 10)
WordChosen = PossibleWords(wordNumber)

End Sub

Standard module:

Option Explicit
Public Const Alphabet As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

Public Enum enumStopGameStatus

GameInProgress = 0
UserLost = 1
UserWon = 2
UserKeptGuessingInvalidLetters = 3

End Enum

Sub PlayHangman()

    Dim IfPlayAgain As Boolean

If MsgBox("Debugging?", vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then Stop


IfPlayAgain = True

Do Until Not IfPlayAgain

IfPlayAgain = False

Dim game As New clsGame

Dim w As New clsWord

game.WordToGuess = UCase(w.WordChosen)
Set w = Nothing

Do Until game.StopGameStatus <> GameInProgress

game.PlayRound

Loop

Select Case game.StopGameStatus

Case enumStopGameStatus.UserWon

MsgBox "Congratulations - you've won! The word was " & game.WordToGuess & "."

Case enumStopGameStatus.UserLost

MsgBox "Sorry - you lost. The word was " & game.WordToGuess & "."

Case enumStopGameStatus.UserKeptGuessingInvalidLetters

MsgBox "Aborted game"

Case Else

MsgBox "Error in code"

End Select

If MsgBox("Do you want to play again?", vbQuestion + vbYesNo + vbDefaultButton2, "Play again?") = vbYes Then IfPlayAgain = True

Set game = Nothing

Loop

End Sub

Try these steps.

1. Open the Hangman game and enable macros.

2. Go to the VB editor, look for the class module, clsGame and Sub PlayRound and put break point on this line:

StopGameStatus = UserKeptGuessingInvalidLetters

3. Press the Play button.

4. When the Debugging messagebox pops up, click No.

5. When the Guess message box pops up, click Cancel.

6. When the "You must type in one (and only one) letter" message box pops up, click OK

7. Click Cancel

8. Click OK

9. Click Cancel

10. Click OK


Now the program should hit the break point.

Look for this line (found in the class module, clsGame and Sub PlayRound):

If Not Letter.IfTooManyGoes Then

Hovering the mouse over the word Not causes the program continues to run and the Guess message box pops up.

Does it happen to you as well?

 

[xenou]

That sounds strange. I'd restart your computer and hope it stops...

 

[tiredofit]

That sounds strange. I'd restart your computer and hope it stops...

Unfortunately it happens every time.

Try it for yourself if you're interested.

 

[xenou]

Its odd yes. Maybe the mouseover invokes code in the property get that creates additional execution in the program.

 

[tiredofit]

Its odd yes. Maybe the mouseover invokes code in the property get that creates additional execution in the program.

So you experienced it too?

 

[yky]

Happens to me too, but not on "Not". Instead, it's "Letter" that triggers the continuation of the code.

 

[tiredofit]

Happens to me too, but not on "Not". Instead, it's "Letter" that triggers the continuation of the code.

VBA never ceases to amaze me!

 

[RoryA]

How would you expect it to show you the value of the property without executing the code?