Étiquette : macro_game

After successfully completing the puzzle, the user is asked whether they want to start a new game. If the answer is Yes, the procedure PromptNewGame() is called to begin a new puzzle. Otherwise, the procedure ClearBoard() is called to clear the board:

Sub PromptNewGame()
    If MsgBox("Congratulations! Start a new game?", _
              vbYesNo, "New Game?") = vbYes Then
        StartGame
    Else
        ClearBoard
    End If
End Sub

Additional Tips:

Enjoy playing, exploring the code, and creating your own extensions! For example:

• Provide multiple images and select one randomly for each new game.
• Adjust the number of puzzle pieces (e.g., 3×3, 4×4, 6×6) to control the difficulty level.
• Track time or number of moves to make it competitive.
• Add sound effects or animations for a more dynamic experience.

The procedure CheckPositions() determines whether, after a swap, all puzzle pieces are arranged correctly:

Sub CheckPositions()
    Dim i As Integer
    Dim j As Integer
    Dim Name1 As String
    Dim Name2 As String
    Dim Piece1 As Shape
    Dim Piece2 As Shape
    Dim AllCorrect As Boolean
    AllCorrect = True
    ' Check horizontal order (row-wise)
    For i = 1 To 5
        For j = 1 To 4
            Name1 = "P" & i & j
            Name2 = "P" & i & (j + 1)
            Set Piece1 = ActiveSheet.Shapes(Name1)
            Set Piece2 = ActiveSheet.Shapes(Name2)
            If Piece1.Left >= Piece2.Left Then
                AllCorrect = False
                Exit For
            End If
        Next j
        If Not AllCorrect Then Exit For
    Next i
    If Not AllCorrect Then Exit Sub
    ' Check vertical order (column-wise)
    For i = 1 To 4
        For j = 1 To 5
            Name1 = "P" & i & j
            Name2 = "P" & (i + 1) & j
            Set Piece1 = ActiveSheet.Shapes(Name1)
            Set Piece2 = ActiveSheet.Shapes(Name2)
            If Piece1.Top >= Piece2.Top Then
                AllCorrect = False
                Exit For
            End If
        Next j
        If Not AllCorrect Then Exit For
    Next i
    If Not AllCorrect Then Exit Sub
    ' If all pieces are correctly positioned, end the game
    GameActive = False
    Application.OnTime Now + TimeValue("00:00:01"), _
        "PromptNewGame"
    Set Piece1 = Nothing
    Set Piece2 = Nothing
End Sub

Explanation:

• Initially, the code assumes all puzzle pieces are correctly positioned: AllCorrect = True.
• Horizontal check (row-wise):
  • For each row (i from 1 to 5), it compares horizontally adjacent pieces (j from 1 to 4).
  • It checks that piece "P" & i & j is strictly to the left of "P" & i & (j+1) using the .Left property.
  • If this condition fails, AllCorrect is set to False and the loop exits early.
• Vertical check (column-wise):
  • For each column (j from 1 to 5), it compares vertically adjacent pieces in rows (i from 1 to 4).
  • It verifies that piece "P" & i & j is above "P" & (i+1) & j using the .Top property.
  • If any piece is vertically out of order, AllCorrect is set to False, and the procedure exits.
• If any check fails, the game continues (i.e., it does not mark the puzzle as solved).
• If all pieces are correctly placed:
  • GameActive is set to False to signal the game has ended.
  • The procedure PromptNewGame() is scheduled to run one second later using Application.OnTime. This ensures visual updates finish before prompting the player.
• Finally, shape references Piece1 and Piece2 are cleared from memory.

During both the initial shuffling of all puzzle pieces and when the user clicks to swap pieces, two puzzle pieces are exchanged using the following procedure:

Sub SwapPieces(Piece1 As Shape, Piece2 As Shape)
    Dim TempLeft As Integer
    Dim TempTop As Integer
    TempLeft = Piece1.Left
    Piece1.Left = Piece2.Left
    Piece2.Left = TempLeft
    TempTop = Piece1.Top
    Piece1.Top = Piece2.Top
    Piece2.Top = TempTop
End Sub

Explanation:

• The procedure receives two references to puzzle pieces (Shape objects) as parameters: Piece1 and Piece2.
• Two temporary variables, TempLeft and TempTop, are used to store the current Left and Top properties (horizontal and vertical positions) of the first puzzle piece.
• The procedure swaps the Left and Top values of the two puzzle pieces, effectively exchanging their positions on the worksheet.

The procedure ClickPiece() is called whenever the user clicks one of the puzzle pieces with the mouse:

Sub ClickPiece()
    If FirstActive Then
        Set FirstPiece = ActiveSheet.Shapes(Application.Caller)
        FirstPiece.PictureFormat.Brightness = 0.25
        FirstActive = False
    Else
        FirstPiece.PictureFormat.Brightness = 0.5
        SwapPieces FirstPiece, ActiveSheet.Shapes(Application.Caller)
        Set FirstPiece = Nothing
        CheckPositions
        FirstActive = True
    End If
End Sub

Explanation:

• The procedure first checks whether the clicked puzzle piece is the first or second piece involved in a swap operation.
• At the end of the StartGame() procedure, just before the first swap, the Boolean variable FirstActive is set to True.
• The Caller property of the Application object returns a reference to the object (shape) that triggered the VBA procedure — in this case, the clicked puzzle piece.
• If FirstActive is True, the reference to the clicked puzzle piece is stored in the module-level variable FirstPiece.
• The piece’s brightness is reduced from the default 0.5 to 0.25 via its PictureFormat.Brightness property, making it appear slightly darker.
• This visual cue helps the user identify which puzzle piece has been selected first for swapping.
• FirstActive is then set to False, signaling that the next clicked piece will be the second in the swap.
• If FirstActive is False, the brightness of the first selected piece is reset back to normal (0.5).
• The procedure SwapPieces() is called next with two parameters: references to the first selected puzzle piece and the currently clicked (second) puzzle piece. This procedure swaps their positions.
• After each swap, the procedure CheckPositions() is called to verify whether all puzzle pieces are now correctly positioned.
• Finally, FirstActive is reset to True to prepare for the next swap operation.

After pressing the START button, the puzzle is displayed for the user, as shown in Figure 11.13. The corresponding procedure Starten() is explained below in parts.

Part 1: Variable Declarations

Sub StartGame()
    Dim AbortSub As Boolean
    Dim shp As Shape
    Dim FilePath As String
    Dim PieceWidth As Integer
    Dim PieceHeight As Integer
    Dim i As Integer
    Dim j As Integer
    Dim Name1 As String
    Dim Name2 As String
    ...

• The Boolean variable AbbruchSub tracks whether the procedure should abort, for example, if the user presses START again during an ongoing game.
• Sh is a reference to a single Shape object.
• Datei holds the path and filename of the image file for the puzzle.
• Breite and Hoehe store the width and height of one puzzle piece.
• i and k control nested loops for creating puzzle pieces.
• Name1 and Name2 store the names of two puzzle pieces to be swapped.

Part 2: Game Restart Confirmation

AbortSub = False
If GameActive Then
    If MsgBox("You are not finished yet. " & _
              "Do you really want to restart?", _
              vbYesNo, "New Start") = vbNo Then
        AbortSub = True
    End If
Else
    GameActive = True
End If
If AbortSub Then Exit Sub

...

• When the START button is pressed, the program checks if a game is already active (SpielAktiv).
• If active, the user is asked whether they want to end the current game and restart.
• Choosing NO sets AbbruchSub to True, immediately exits the procedure, and keeps the current game intact.
• Choosing YES keeps AbbruchSub as False, allowing the procedure to continue and shuffle the pieces.
• If no game is running, SpielAktiv is set to True, and the puzzle pieces will be shuffled for the start.

Part 3: Prepare Puzzle Pieces

DeleteAllPieces
FilePath = ThisWorkbook.Path & "\paradise.jpg"
Set shp = ActiveSheet.Shapes.AddPicture( _
    FilePath, msoFalse, msoTrue, 10, 10, -1, -1)
PieceWidth = shp.Width / 5
PieceHeight = shp.Height / 5
shp.Delete

• All existing puzzle pieces and gridlines are deleted.
• The path and filename of the image are stored in Datei.
• The AddPicture() method inserts the image as a shape and returns a reference to it.
• Parameters:
  • First: image file path.
  • Second (msoFalse): the image is embedded, not linked (so changes to the original file do not affect the embedded copy).
  • Third (msoTrue): the image is saved with the workbook.
  • Fourth and fifth: position offsets (Left and Top) in points.
  • Sixth and seventh: width and height (-1 means use original size).
• The puzzle consists of 25 pieces arranged in a 5×5 grid. The width and height of each piece are calculated as one-fifth of the full image dimensions.
• The inserted image shape is deleted after measuring, as it was only needed to determine piece size.

Part 4: Creating Puzzle Pieces

For i = 1 To 5
    For j = 1 To 5
        Set shp = ActiveSheet.Shapes.AddPicture( _
            FilePath, msoFalse, msoTrue, _
            100 + j, 10 + 4 * i, -1, -1)
        With shp.PictureFormat
            .CropLeft = (j - 1) * PieceWidth
            .CropRight = (5 - j) * PieceWidth
            .CropTop = (i - 1) * PieceHeight
            .CropBottom = (5 - i) * PieceHeight
        End With
        shp.Name = "P" & i & j
        shp.OnAction = "ClickPiece"
    Next j
Next i

• The image file is inserted 25 times to create 25 puzzle piece objects.
• Each piece is positioned slightly more to the right and down than the previous to create visible spacing.
• The CropLeft, CropRight, CropTop, and CropBottom properties of PictureFormat crop each piece to show only the respective segment of the full image.
• For example, the top-left piece (i=1, k=1) has no crop on the left or top (crop values 0), and 4/5 of the width and height cropped off on the right and bottom.
• Pieces are named according to their grid position, e.g., « P11 » for top-left, « P12 » right next to it, « P21 » below « P11 », and « P55 » for bottom-right.
• The OnAction property assigns the procedure « Klick » to each piece so that clicking it triggers the selection handler.

Part 5: Shuffling Puzzle Pieces

    For i = 1 To 100
        Name1 = "P" & Int(Rnd * 5 + 1) & Int(Rnd * 5 + 1)
        Name2 = "P" & Int(Rnd * 5 + 1) & Int(Rnd * 5 + 1)
        SwapPieces ActiveSheet.Shapes(Name1), _
                   ActiveSheet.Shapes(Name2)
    Next i
    FirstClickActive = True
    Set shp = Nothing
End Sub

• The puzzle pieces are shuffled by swapping two randomly selected pieces 100 times.
• Piece names are generated randomly for both pieces to be swapped.
• The references to the two pieces are passed to the procedure Tauschen(), which performs the swap.

The following module-level variables are declared in Module1:

Option Explicit
Dim FirstActive As Boolean
Dim FirstShape As Shape
Dim GameActive As Boolean

Explanation:

• The Boolean variable ErstesAktiv stores whether the first image (puzzle piece) has already been selected during the swapping process.
• The variable Erstes is a reference to the first selected puzzle piece (Shape) involved in the swapping operation.
• The Boolean variable SpielAktiv indicates whether the game is currently running and not yet finished. This is important to manage cases when the user presses the START button again during an ongoing game.

Removing all puzzle pieces is done using the procedure DeleteAllShapes() , which is called at multiple points in the program:

Code

Sub DeleteAllShapes()
    Dim ShapeObj As Shape
    ThisWorkbook.Worksheets("Sheet1").Activate
    ActiveWindow.DisplayGridlines = False
    For Each ShapeObj In ActiveSheet.Shapes
        ShapeObj.Delete
    Next ShapeObj
    Set ShapeObj = Nothing
End Sub

Explanation:

In Excel, inserting an image from a file is done by going to the Insert tab and clicking on the Pictures button. After selecting the image file, it is inserted into the workbook as an object.

When inserted, the image becomes part of the worksheet’s Shapes collection. This collection includes all objects like pictures, charts, buttons, etc.

The DeleteAllShapes() procedure:

1. Activates the worksheet named "Sheet1".
2. Hides the gridlines in the active window by setting ActiveWindow.DisplayGridlines = False.
3. Uses a For Each loop to iterate through all shapes on the active sheet.
4. Deletes each shape using the .Delete method.
5. Cleans up by setting the shape object variable to Nothing.

The vocabulary list is located on the second worksheet. The user can view the vocabulary for study purposes and may freely extend, modify, or shorten the list, provided that the structure of the list is maintained.

Structure of the List:

• The first row contains the headers.
• The rows below contain the vocabulary entries.
• The user can control the length of the test by inserting a blank row.
• During a test, only the vocabulary entries up to the first blank row are included.

In the class module ThisWorkbook, you will find the procedure Workbook_Open():

Private Sub Workbook_Open()
    ThisWorkbook.Worksheets("Sheet1").Activate
End Sub

This procedure ensures that after opening the file, the user always sees the worksheet with the Start button for the vocabulary test, preventing accidental viewing of the vocabulary collection.

In Module1, you will find two module-wide variables and the procedure Start(). These are used to initialize the game and manage the game state.

Variables:

Public Direction As Integer 
Dim Started As Boolean

Explanation:

• The variable Direction is declared with workbook-wide scope because it is accessed by multiple procedures across modules or multiple calls to the same procedure.
• The Boolean variable Started is scoped to this module and prevents the game from being started more than once if it is already running.
• Direction holds the snake’s current movement direction as an integer value.

Procedure Start():

Sub Start()
    Dim StartTime As Single
    Dim WaitTime As Single
    Dim RowSnake As Integer, ColSnake As Integer  ' Snake position (row, column)
    Dim RowPrey As Integer, ColPrey As Integer    ' Prey position (row, column)
    Dim GameOver As Boolean
    ' Prevent multiple starts
    If Started Then Exit Sub
    Started = True
    ' Clear game board colors
    Range("B2:K11").Interior.Color = xlNone
    ' Reset score counter
    Range("N8").Value = 0
    ' Initial wait time between moves (in seconds)
    WaitTime = 0.5
    ' Game not over yet
    GameOver = False
    ' Set snake start position and color
    RowSnake = 10
    ColSnake = 6
    Cells(RowSnake, ColSnake).Interior.Color = vbGreen
    ' Initial movement direction: up (0)
    Direction = 0
    ' Set prey start position and color
    RowPrey = 3
    ColPrey = 9
    Cells(RowPrey, ColPrey).Interior.Color = vbRed
    ' Initialize random number generator
    Randomize
    ' Main game loop runs until collision ends the game
    Do While Not GameOver
        ' Start timer for delay
        StartTime = Timer
        ' Wait for the duration of WaitTime
        Do While Timer < StartTime + WaitTime
            DoEvents ' Allow user interaction during wait
        Loop
        ' Clear old snake cell color
        Cells(RowSnake, ColSnake).Interior.Color = xlNone
        ' Move snake according to direction
        If Direction = 0 Then ' Up
            If RowSnake >= 3 Then
                RowSnake = RowSnake - 1
            Else
                GameOver = True
            End If
        ElseIf Direction = 1 Then ' Right
            If ColSnake <= 10 Then
                ColSnake = ColSnake + 1
            Else
                GameOver = True
            End If
        ElseIf Direction = 2 Then ' Down
            If RowSnake <= 10 Then
                RowSnake = RowSnake + 1
            Else
                GameOver = True
            End If
        Else ' Left (3)
            If ColSnake >= 3 Then
                ColSnake = ColSnake - 1
            Else
                GameOver = True
            End If
        End If
        ' Color new snake cell
        Cells(RowSnake, ColSnake).Interior.Color = vbGreen
        ' Check if snake "eats" the prey
        If RowSnake = RowPrey And ColSnake = ColPrey Then
            ' Increase score by 1
            Range("N8").Value = Range("N8").Value + 1
            ' Set prey to new random position
            RowPrey = Int(Rnd * 10 + 2)
            ColPrey = Int(Rnd * 10 + 2)
            Cells(RowPrey, ColPrey).Interior.Color = vbRed
            ' Decrease wait time by 10% to speed up snake
            WaitTime = WaitTime * 0.9
        End If
    Loop
    ' Game over message
    MsgBox "End of the game", , "Game Over"
    ' Reset started flag for next game
    Started = False
End Sub

Detailed Explanation:

• StartTime and WaitTime control a timing loop to manage the delay between snake movements. StartTime records the current time when the loop starts, and WaitTime determines how long to wait before the snake moves again. This wait time decreases after each prey eaten, making the snake move faster.
• RowSnake and ColSnake represent the current row and column of the snake on the board. RowPrey and ColPrey represent the row and column of the prey.
• The Boolean GameOver flags the end of the game when set to True, such as when the snake collides with the board boundary.
• The Boolean Started prevents multiple game starts.
• Upon the first start, the game board’s interior cells are cleared of any color, the counter reset to 0, and the snake and prey placed at initial “safe” positions (snake colored green, prey colored red).
• The snake initially moves upward (Direction = 0).
• The Randomize statement prepares the random number generator to position the prey randomly.
• The main game loop runs until GameOver becomes True. Inside this loop, a timer-based delay lets the user interact, changing the snake’s direction if desired.
• After waiting, the snake’s old cell is cleared, and a new position is calculated based on the current direction.
• If the snake reaches the prey’s position, the counter increments, the prey moves randomly, and the snake’s speed increases.
• When the snake hits the boundary, the game ends with a message box.
• Finally, the Started flag resets to allow restarting.

In the class module for Sheet1, you will find the procedure Worksheet_SelectionChange(). This procedure is responsible for handling user input during the game.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$M$2:$O$2" Then
        Starten
    ElseIf Target.Address = "$M$11:$O$11" Then
        MsgBox "The green snake must eat the red prey to earn points." & vbCrLf & _
               "After eating, the snake speeds up." & vbCrLf & _
               "You can steer the snake, but you cannot immediately reverse its direction." & vbCrLf & _
               "The game ends when the snake hits the wall.", , "Game Instructions"
    ElseIf Target.Address = "$N$4" Then
        If Richtung <> 2 Then Richtung = 0
    ElseIf Target.Address = "$O$5" Then
        If Richtung <> 3 Then Richtung = 1
    ElseIf Target.Address = "$N$6" Then
        If Richtung <> 0 Then Richtung = 2
    ElseIf Target.Address = "$M$5" Then
        If Richtung <> 1 Then Richtung = 3
    End If
    ' Reactivate center cell to ensure SelectionChange event fires next time
    Range("N5").Activate
End Sub

Explanation:

• The Worksheet_SelectionChange() event is triggered whenever the user selects a new cell.
• The selected cell or merged range is passed as the Target object. Its .Address property returns the address as a string.
• If the START button cells (address $M$2:$O$2) are selected, the Starten procedure in Module1 is called to start the game.
• If the INFO button cells (address $M$11:$O$11) are selected, a message box displays the game instructions.
• The four cells N4, O5, N6, and M5 correspond to controls for changing the snake’s movement direction:
  • N4 sets direction up (0), unless the current direction is down (2), which would be an immediate reversal and is disallowed.
  • O5 sets direction right (1), unless the current direction is left (3).
  • N6 sets direction down (2), unless current direction is up (0).
  • M5 sets direction left (3), unless current direction is right (1).
• The directions 0, 1, 2, 3 correspond to up, right, down, and left, respectively — arranged clockwise.
• Finally, the cell N5 (center of the four direction controls) is reactivated. This is important because the SelectionChange event only fires when the active cell changes. Without this step, clicking the same directional cell repeatedly would not trigger the event.