Wingding Match desktop game for Excel

Wingding Match desktop game for Excel - Alex Shaw III

Overview of Wingding Match

Wingding Match is an open source dynamic matching game for Excel. However, there is a twist to this game. If you miss two consecutive matches, then the pieces are scrambled. Unfortunately, we did not take into account how difficult it would be to complete the game. Especially, on level three.

So, with the scramble feature, perhaps we should had awarded additional lives. Well, since the game is open source, you can make changes on your end.

The levels

Levels to Wingding desktop game for Excel - Alex Shaw III

Play the game

Requirements to play WIngdingMicrosoft Excel 2003 or higher or compatible.

Download Wingding

Code listing

'Designed and programmed by: Alex Shaw III
'Date created: August 31, 2008
'Last modified: September 11, 2008
'Note: Printout in landscape mode for clarity

Option Explicit                                 'require declaration
Option Base 1                                   'start array allocation at one

Public appVer           As String               'application version
Public cellRefs         As Variant              'cell reference locations
Public conMiss          As Integer              'consecutive misses
Public levelAtts        As Integer              'level attempts
Public levelMax         As Variant              'maximum boxes per level
Public levNum           As Integer              'level number
Public matchChars       As Variant              'match characters
Public matchCount       As Integer              'match count
Public missBonus        As Integer              'miss bonus
Public pickCount        As Integer              'pick count
Public score            As Long                 'score
Public totalAtts        As Integer              'total attempts

Dim gameChars(1 To 6)   As Integer              'game characters for up to 12 matches
Dim pickChar(1 To 2)    As String               'pick character

Public Sub matchBoxB16()
    Call Check_Match("B16")
End Sub

Public Sub matchBoxC13()
    Call Check_Match("C13")
End Sub

Public Sub matchBoxC17()
    Call Check_Match("C17")
End Sub

Public Sub matchBoxD7()
    Call Check_Match("D7")
End Sub

Public Sub matchBoxD11()
    Call Check_Match("D11")
End Sub

Public Sub matchBoxD15()
    Call Check_Match("D15")
End Sub

Public Sub matchBoxD19()
    Call Check_Match("D19")
End Sub

Public Sub matchBoxE12()
    Call Check_Match("E12")
End Sub

Public Sub matchBoxE16()
    Call Check_Match("E16")
End Sub

Public Sub matchBoxF10()
    Call Check_Match("F10")
End Sub

Public Sub matchBoxF14()
    Call Check_Match("F14")
End Sub

Public Sub matchBoxG12()
    Call Check_Match("G12")
End Sub

Private Sub Calc_Level_Points(addSub As Integer, ParamArray lev() As Variant)
    If (addSub = 0) Then                                    'add to score
        Select Case levNum                                  'calculate score based on level
            Case 1: score = score + lev(0)                  'level 1 and consecutive miss increase
            Case 2: score = score + lev(1)                  'level 2 and consecutive miss increase
            Case 3: score = score + lev(2)                  'level 3 and consecutive miss increase
        End Select
    Else                                                    'subtract from Score
        Select Case levNum                                  'calculate score based on level
            Case 1: score = score - lev(0)                  'level 1
            Case 2: score = score - lev(1)                  'level 2
            Case 3: score = score - lev(2)                  'level 3
        End Select
    End If

    Range("score").Value = score                            'display score
End Sub

Private Sub Check_Match(cellRef As String)
    If (Shapes("matchBox" & cellRef).Visible = True) Then                           'check to see if box is visible
        pickCount = pickCount + 1                                                   'increment pick count
        pickChar(pickCount) = cellRef                                               'pick character

        Call Calc_Level_Points(0, 25, 50, 75)                                       'calculate level points
        If (pickCount < 3) Then Shapes("matchBox" & cellRef).Visible = False        'hide match box

        If (pickCount = 2) Then
            Call Time_Delay(0.5)                                                    'pause for a half-second
            pickCount = 0                                                           'start new pick count
            If (Range(pickChar(1)).Value = Range(pickChar(2)).Value) Then           'match was found
                Call Display_Message("Match found!")                                'display match message
                Call Calc_Level_Points(0, 500, 1000, 1500)                          'calculate level points
                conMiss = 0                                                         'reset consecutive misses
                matchCount = matchCount + 1                                         'increment match count
                score = score + missBonus                                           'apply miss bonus
                Range("score").Value = score                                        'display score
                If (matchCount = levelMax(levNum) / 2 And levNum <> 3) Then         'check for level completion
                    Call Display_Message("Level " & levNum & " completed!")         'display level completion message
                    Call Calc_Level_Points(0, 2000, 3000, 5000)                     'calculate bonus points
                    levNum = levNum + 1                                             'move to next level
                    matchCount = 0                                                  'start match count over
                    missBonus = 0                                                   'reset miss bonus
                    levelAtts = levelMax(levNum)                                'reset amount of level attempts
                    Range("attempts").Value = levelAtts                             'display level attempts
                    Range("level").Value = "Level " & levNum                        'display level number
                    Call Prepare_Game(levNum)                                       'prepare new level
                ElseIf (matchCount = levelMax(levNum) / 2 And levNum = 3) Then      'check for game completion
                    Call Calc_Level_Points(0, 2000, 3000, 5000)                     'calculate bonus points
                    Call Game_Over                                                  'game over routine
                End If
            Else                                                                    'match was not found
                Call Display_Message("Try again lucky!")                            'display miss message
                Call Calc_Level_Points(1, 50, 100, 150)                             'subtract points from score
                conMiss = conMiss + 1                                               'increment consecutive misses
                levelAtts = levelAtts - 1                                           'increment level attempts
                totalAtts = totalAtts + 1                                           'increment total attempts
                Range("attempts").Value = levelAtts                                 'display total attempts
                Shapes("matchBox" & pickChar(1)).Visible = True                     'display match box for first pick
                Shapes("matchBox" & pickChar(2)).Visible = True                     'display match box for second pick
                If (levelAtts = 0) Then
                    Call Game_Over                                                  'check level attempts
                End If
                If (conMiss = 2 And levelAtts <> 0) Then                            'check consecutive misses
                    Shapes("gameMes2").Visible = True                               'display scrambling message box
                    Call Scramble                                                   'scramble characters
                ElseIf (levelAtts <> 0) Then

                End If
            End If
        End If
        Call Worksheet_Activate                                                     'restart game
    End If
End Sub

Private Sub Clear_Chars()
    Dim n As Integer                    'counting variable
    For n = 1 To UBound(cellRefs)       'check all references in game
        Range(cellRefs(n)).Value = ""   'clear cell value

    For n = 1 To UBound(gameChars)      'assign zero to game characters
        gameChars(n) = 0                'initialize game character
End Sub

Private Sub Display_Message(message As String)
    Range("message").Value = message                            'display message
End Sub

Public Sub End_Game()
    ThisWorkbook.Close SaveChanges:=False                       'close game without saving
End Sub

Private Sub Game_Over()
    If (matchCount = levelMax(levNum) / 2 And levNum = 3) Then                  'user won
        Call Display_Message("Congratulations! You have completed the game!")   'display congratulation message
        score = score + 7500                                                    'add bonus to score
        Range("score").Value = score                                            'display bonus
    Else                                                                        'user lost
        Call Display_Message("Game Over! You lose! Please try again!")          'display lost message
        Call Clear_Chars                                                        'clear characters
        Call Hide_Boxes(1, 12)                                                  'hide boxes
    End If

    Shapes("gameMes1").Visible = True                                           'show game over box
End Sub

Private Sub Get_Chars()
    Dim n        As Integer                                     'counting variable
    Dim randNum  As Integer                                     'random number
    Dim tmpArray As Variant                                     'temporary array
    tmpArray = Randomize_Array(matchChars)                      'randomize temporary array
    n = 1                                                       'initialize counting variable
    Do While (n < levelMax(levNum) / 2 + 1)                     'select characters based on maximum matches
        randNum = Int(Rnd * UBound(tmpArray)) + 1               'obtain random number
        If (Int(Rnd * 3) = 2 And tmpArray(randNum) <> 0) Then   'check for open random position in temporary array
            gameChars(n) = tmpArray(randNum)                    'assign value from temporary array to game character
            tmpArray(randNum) = 0                               'assign zero to random location in temporary array
            n = n + 1                                           'increment counting variable
        End If
End Sub

Private Sub Hide_Boxes(startNum As Integer, endNum As Integer)
    Dim n As Integer                                        'counting variable
    For n = startNum To endNum                              'hide only a particular range of match boxes
        Shapes("matchBox" & cellRefs(n)).Visible = False    'hide match box
End Sub

Private Sub Hide_Messages()
    Dim n As Integer                                        'counting variable
    For n = 1 To 2
        Shapes("gameMes" & n).Visible = False               'hide game message
End Sub

Private Sub Initialize()
    cellRefs = Array("C17", "D7", "D11", "D15", "D19", "E12", "C13", "E16", "B16", "F10", "F14", "G12")
    levelMax = Array(6, 8, 12)
    matchChars = Array(33, 34, 36, 37, 38, 39, 40, 41, 43, 46, 49, 50, 53, 56, 68, 93, 94, 98, 100, 102)

    appVer = Application.Version            'application version
    conMiss = 0                             'consecutive misses
    levelAtts = 3                           'level attempts
    levNum = 1                              'level number
    matchCount = 0                          'match count
    missBonus = 0                           'miss bonus
    pickCount = 0                           'pick count
    score = 0                               'game score
    totalAtts = 0                           'total attempts

    Range("score").Value = score            'display score
    Range("attempts").Value = levelAtts     'display attempts
    Range("level").Value = "Level 1"        'display level
    Range("A1").Select                      'select A1 to display game board
End Sub

Public Sub Instructions()
End Sub

Private Sub Place_Chars()
    Dim m As Integer, n As Integer, j As Integer
    Dim cellArray() As String, charArray() As Integer
    ReDim cellArray(levelMax(levNum)), charArray(UBound(gameChars))
    For n = 1 To levelMax(levNum)
        cellArray(n) = cellRefs(n)                                          'copy values from cell reference to cell array
    charArray = gameChars                                                   'assign game characters to character array

    For m = 1 To 2
        cellArray = Randomize_Array(cellArray)                              'randomize match box cells
        j = 1                                                               'initialize counter
        For n = 1 To UBound(cellArray)                                      'count each cell in cell array
            If (cellArray(n) <> "" And j < levelMax(levNum) / 2 + 1) Then   'check cell in cell array
                Range(cellArray(n)).Value = "'" & Chr(charArray(j))         'assign value to cell in game
                cellArray(n) = ""                                           'clear assigned value
                j = j + 1                                                   'increment counter
            End If
End Sub

Private Sub Prepare_Game(gameLev As Integer)
    Dim levMax As Integer                       'maximum match boxes on a particular level
    levMax = levelMax(gameLev)                  'assign maximum boxes for chosen level
    Call Hide_Messages
    Call Clear_Chars
    Call Hide_Boxes(1, 12)
    Call Show_Boxes(1, levMax)
    Call Get_Chars
    Call Place_Chars
End Sub

Private Function Randomize_Array(tmpArray As Variant) As Variant
    Dim m As Integer, n As Integer              'counting variables
    Dim tmpVal As Variant                       'hold value in array
    For m = 1 To UBound(tmpArray)               'check each value in array
        n = Int(Rnd * UBound(tmpArray)) + 1     'obtain random position in array
        tmpVal = tmpArray(m)                    'assign original value from array
        tmpArray(m) = tmpArray(n)               'swap current value with random value
        tmpArray(n) = tmpVal                    'assign random value with original value
    Randomize_Array = tmpArray                  'return value
End Function

Private Sub Scramble()
    Dim cellArray()     As String
    Dim charArray()     As Integer
    Dim numOfBoxes      As Integer
    Dim m               As Integer
    Dim n               As Integer
    Call Display_Message("You missed two times in a row. Scrambling characters!")
    numOfBoxes = 0                                                                      'initialize number of boxes variable
    For n = 1 To levelMax(levNum)                                                       'check all boxes on level
        If (Shapes("matchBox" & cellRefs(n)).Visible) Then numOfBoxes = numOfBoxes + 1  'count visible box

    ReDim charArray(1 To numOfBoxes), cellArray(1 To numOfBoxes)    'reallocate space based on visible boxes
    m = 1                                                           'initialize counting variables
    For n = 1 To levelMax(levNum)                                   'count all visible boxes on level
        If (Shapes("matchBox" & cellRefs(n)).Visible) Then          'check for visibility
            charArray(m) = Asc(Range(cellRefs(n)).Value)            'assign ASCII value of cell
            cellArray(m) = cellRefs(n)                              'get cell reference
            m = m + 1                                               'increment counting variable
        End If

    charArray = Randomize_Array(charArray)                          'randomize character array
    cellArray = Randomize_Array(cellArray)                          'randomize cell array
    For n = 1 To UBound(charArray)                                  'check each character in character
        Range(cellArray(n)).Value = "'" & Chr(charArray(n))         'display character

    conMiss = 0                                                     'reset consecutive misses variable
    missBonus = missBonus + 250                                     'increment consecutive misses bonus

    Call Time_Delay(1)                                              'delay game
    Shapes("gameMes2").Visible = False                              'hide scrambling message box
End Sub

Public Sub Show_All_Boxes()
    Dim cellRef As Variant                                      'allocate space for each match cell reference in game
    If (Range("K1").Value = "admin") Then                       'only administrator can show all boxes
        Call Initialize                                         'initialize variables
        For Each cellRef In cellRefs                            'check each cell reference in match cell array
            Shapes("matchBox" & cellRef).Visible = True         'display match box
    End If
End Sub

Private Sub Show_Boxes(startNum As Integer, endNum As Integer)
    Dim n As Integer                                                                        'counting variable
    For n = startNum To endNum                                                              'show a particular range of match boxes
        Select Case levNum                                                                  'apply appropriate color to match boxes
            Case 1
            Case 2
            Case 3
        End Select
        Shapes("matchBox" & cellRefs(n)).Visible = True                                     'display match box
End Sub

Public Sub Start_Game()
    Call Initialize                                         'initialize variables
    Call Prepare_Game(1)                                    'start with level 1
    Call Display_Message("Go ahead, make your match!")      'display start message
End Sub

Private Sub Time_Delay(secs As Single)
    Dim startTime As Variant
    startTime = Timer                           'assign current time to a variable
    Do While Timer < startTime + secs           'continue loop until appropriate seconds elapse
        DoEvents                                'allow other processes to run
End Sub

Private Sub Worksheet_Activate()
    Call Start_Game
End Sub


Games home

AS3rd home