Wingding Match game for Microsoft Excel

Wingding Match game for Microsoft Excel

Wingding Match game for Microsoft Excel

Wingding Match game (or WMG) for Excel

Requirements

Microsoft Excel 2003 or higher or compatible.

Download


Wingding Match

Below is a video showcasing realtime play of WMG.

Wingding Match is a desktop game for Microsoft Excel. Overall, it has three levels. And, there is one twist to this game. If you miss consecutive matches, then the pieces are shuffled again.

Now, the shuffling feature is okay for the amount of pieces in this game. However, we do not include this feature in a bigger game like Bubble Dip Match.

So, we do not offer support for this game and most items in our vintage collection. In order to play this game, you must enable macros in Excel.

Known bug in Wingding Match

There is a known bug in WMG. You see, when a level loads, somethings you see the placement of the characters before they are hidden. Um, um, um. So, in our next game, we fixed that problem. If you want to fix it, then view the code (Alt + F11) to the game in Excel.

Or, you can view the code listing right here.

The levels

On the whole, there are three levels to this game. Below are screenshots of the three levels.

First level

First level of Wingding Match
Firstly, we know the first level looks easy.

Second level

Second level of Wingding Match
Secondly, the second level really puts you through the test.

Third level

Third level of Wingding Match
Finally, the third level is out of control. Difficult to win.

Requirements

Microsoft Excel 2003 or higher or compatible.

Download


Code listing

Below, is the code listing to Wingding Match.

'wingding_match.xls
'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
    Else
        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
    Next

    For n = 1 To UBound(gameChars)      'assign zero to game characters
        gameChars(n) = 0                'initialize game character
    Next
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
    
    Randomize
    
    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
    Loop
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
    Next
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
    Next
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()
    Sheet2.Activate
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
    Next
    
    charArray = gameChars                                                   'assign game characters to character array
    
    Randomize

    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
        Next
    Next
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
    
    Randomize
    
    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
    Next
    
    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
    Next

    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
    Next

    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
    Next

    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
        Next
    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
    Next
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
    Loop
End Sub

Private Sub Worksheet_Activate()
    Call Start_Game
End Sub

Related


Games home  Excel Effects home