Étiquette : excel_vba

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.