Getting control in my main macro code when a shape is selected|VBA & Macros|Excel Forum|My Online Training Hub

Mr Bombea:

I'm attempting to make a "Wordle" like game (named Fourdle) that is played in an Excel worksheet.

It currently only uses 4 letter words.  My intent is to make a tool used by elementary level school teachers which allows them to create 4 letter words and their definitions.  Where the definitions are partially revealed as the student gets more of the letters in his guess correct.

VBA does not appear to me to have the ability to do something like stop_execution.OnAction = "GoTo anylabel", instead, the OnAction requires me to reference a subroutine.  I have found a way around this by 1. Deleting a fixed named file (Signal) if it exists on macro startup, then when the stop_execution button (Shape) is selected by the user, writing the "Signal" file to the hard drive, while constantly querying for the file's existence in the infinite loop.  When it is detected, then I write the current Fourdle game state to a "history" file and terminate the macro execution.  This workaround has the disadvantage of only working while a single user is playing the game due to not having a different signal file name for each player.

I am in an infinite loop in the fourdle macro code

Sub fourdle()
Dim version As String 'Macro revision version number.
Dim number_of_worksheets As Integer 'Total number of sheets in this workbook.

...

'Create path to signal file in the current working directory.
signal_file_name = ThisWorkbook.Path & "\" & "Signal"

'If the signal file exists on game startup, then delete it.
If Len(Dir(signal_file_name)) > 0 Then
Kill signal_file_name
End If

...

'Create the game stop button.
'Set stop_execution = Worksheets(game_sheet_pos).Shapes.AddShape(msoShapeRectangle, 20, 20, 72, 72)
sh_left = Cells(2, 10).Left
sh_top = Cells(2, 10).Top
sh_width = Cells(2, 10).Width
sh_height = Cells(2, 10).Height
Set stop_execution = ActiveSheet.Shapes.AddShape(msoShapeRectangle, sh_left, sh_top, sh_width, sh_height)
stop_execution.Fill.ForeColor.RGB = colorx(cyanx)
stop_execution.OnAction = "StopAndSave"
stop_execution.TextEffect.Text = "STOP & SAVE"

'The game setup and display has been established now so start the infinite loop which monitors for word guess input.

Check_For_New_Input:
While (1)

...

'The player enters characters in cells while this loop is executing

...

Waiting_For_All_Four:
start_time = Timer
DoEvents
Application.Wait (Now + TimeValue("00:00:03"))
end_time = Timer
'MsgBox ("Event delay = " & (finish - Start))
wait_time = end_time - start_time
If Len(Dir(signal_file_name)) > 0 Then
GoTo StopAndSave1
End If

x = x 'Breakpoint place holder.
Wend

StopAndSave1:
'MsgBox ("GAME TERMINATED BY USER")

'Change the stop box to red to indicate the game is stopping.
stop_execution.Fill.ForeColor.RGB = colorx(redx)
DoEvents

'The logic to write the current game history to a disk file with a name unique to the player has yet to be written, but goes here.
x = x 'Breakpoint
GoTo Macro_Exit

'This subroutine gets called when the player presses the "Stop & Save" button.

Sub StopAndSave()
Dim signal_file_name As String
Dim output_file_number As Long

signal_file_name = ThisWorkbook.Path & "\" & "Signal"

If Len(Dir(signal_file_name)) <= 0 Then
'Signal file does not exist.

'Get the next available file number.
output_file_number = FreeFile() 'Open the raw output file.
Open signal_file_name For Output As output_file_number Len = 8192
Write #output_file_number, "Signal"
Close #output_file_number
Else
'Ignore multiple requests to quit.
End If
x = x 'Breakpoint
End Sub

Mr Bombea:

Thanks.

That response fixes the problem and will allow multiple users to use the

"Write to a file from a subroutine to communicate with the main module" technique.

Nels