Wingding Match desktop game for Excel

Wingding Match for Excel

Wingding Match (or WM) for Excel is a fun and dynamic matching game.


Requirements and download

If you feel you are ready to play now, then click on the download button below.

Download Size: 78 kB

Note: Instead of running this game from the zip file, save it to a location on your computer. It runs better that way.


Overview of Wingding Match

Before we get started, check out a video on WM in action, and enjoy yourself.

Watch video

Remember, WM is a matching game. However, there is a twist to the game, which we discuss in the Playing the game section.

Before you play

If you try to run the game without saving it from the zip file, then you may need to go through the prompts below.

  1. Disable protected view for this game
  2. Enable macros for this game

Disable protected view for this game

When you first open WM, you may see a protected view message. Simply click Enable Editing.

WM - Protected view message
Most likely, you will not be able to play this game in protected view. Thus, click Enable Editing.

Enable macros for this game

Our macros for this game are safe. Therefore, click Enable Content.

Wingding Match - Security warning
Our macros are safe and required to play WM. Therefore, click Enable Content and you are good to go.

Playing the game

So, playing WM is pretty easy. But remember, the twist.

The twist

Here is the twist… If you miss two matches in a row, then the pieces are scrambled. Unfortunately, given the amount of saves you have, it makes the game much more difficult to win.

In hindsight, we should had given the player more saves when they make consecutive matches. Or, something like that.

The levels

Overall, WM has three levels.

Level one
WM - Level one
First level.
Level two
Wingding Match - Level two
Second level.
Level three
WM - Level three
Third level.

Bug in the game

So, there is a small bug in the game. You see, when you start a new game or go to the level, it may be possible to see the matching characters. Since we caught it late after the launch, we decided not to fix it.


The code

'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

Of course, you can also see the code for WM directly in Excel. Once you open WM, press Alt F11 to view the complete code. Also, you can access the code through the Developer ribbon.


Requirements and download

To start playing Wingding Match, click on the Download button below.

Requirements: Excel 2003 or higher or compatible.

Download Size: 78 kB

Note: Instead of running this game from the zip file, save it to a location on your computer. It runs better that way.


Related


Games home  Techronology home