564 attributed reviews in the last 3 years
Refreshingly small course sizes
Outstandingly good courseware
Whizzy online classrooms
Wise Owls only (no freelancers)
Almost no cancellations
We have genuine integrity
We invoice after training
Review 30+ years of Wise Owl
View our top 100 clients
Creating classes in VBA - class modules
Part six of a six-part series of blogs
Those who want to add spice to their VBA programming can learn how to create classes, or class modules, and become object-orientated programmers. It's difficult, but fun - and this multi-part blog will guide you along the way.
The rest of this page goes into some detail about the hangman game. You can download the workbook and all of its classes and code here.
When a user first loads the game, we want them to see a single button:
When a user clicks on the button, it should initiate a game of hangman.
We want the game to show a form at the top for the word itself, and keep track of successful and unsuccessful guesses:
Here a user has had 6 wrong guesses, and has 4 lives left. The word is ZOOLOGY.
We'll want to display an InputBox repeatedly to ask the user for letters to guess:
The input box to ask for the next letter.
The game must check that a single character is typed in each time.
For this example, one obvious class stands out for me: an object to represent the game itself. Here's how we'll manage the lifetime of our clsGame class:
|Event||What should happen|
|Instantiating a new game||The class should create a single workbook to contain the guesses and to reveal the answer letter by letter.|
|Terminating the game||At this point, the class should close down the workbook that it created for playing the game.|
The properties and methods that we'll create are as follows:
|WordToGuess||Read-write property||When the class knows what word is being guessed, it should format the workbook created on instantiation and create a mask for the word being guessed.|
|PlayRound||Method||Every time this method is called, the system should ask the user to guess one letter.|
|StopGameStatus||Read-only Property||At the end, we should be able to ask the class whether the game was won, lost or aborted.|
A slightly less obvious class is to create a clsGuess object whenever another letter needs guessing. This would have the following properties and methods:
|StartGuess||Method||Run this method to start the process of guessing a new letter.|
|IfTooManyGoes||Read-only Property||Returns True or False, depending on whether a user has failed to type in a letter correctly 3 (say) times or not.|
|IfAlreadyGuessed||Read-only Property||Returns True or False, depending on whether a user has already guessed this letter.|
|IfGuessCorrect||Read-only Property||Returns True or False, depending on whether a letter guessed exists in the word in question.|
As always, I could have chosen a hundred other ways to solve this problem, and there's no obvious way to tell which one would be best.
The least obvious class that I've created is one to randomly generate a word to guess from a list of 10 possible candidates. All that this will contain is a single read-only property:
|WordChosen||Read-only property||Returns a generated random word from a pre-set list.|
When a user clicks on the button to start a game, we create a new instance of the clsGame class:
Dim IfPlayAgain As Boolean
If MsgBox("Debugging?", vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then Stop
'keep playing till user gets bored
IfPlayAgain = True
Do Until Not IfPlayAgain
'assume will only play once
IfPlayAgain = False
'start a new game (runs INITIALIZE event)
Dim game As New clsGame
This in turn triggers the initialisation code, which creates a new workbook and makes sure it contains only one (named) worksheet:
Private Sub Class_Initialize()
'on starting a game, create new workbook
Set HangmanBook = Workbooks.Add
'don't stop game unless asked
StopGameStatus = GameInProgress
'get only one workseet
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> ActiveSheet.Name Then
Application.DisplayAlerts = False
Application.DisplayAlerts = True
'rename this worksheet
ActiveSheet.Name = "Hangman"
The main code then assigns a word to guess:
'choose a random word
Dim w As New clsWord
game.WordToGuess = Ucase(w.WordChosen)
Set w = Nothing
These innocent 3 lines of code:
Let's take this bit by bit! First, here's what the clsWord class looks like:
Public WordChosen As String
Private Sub Class_Initialize()
'on creation of a new word, generate one
Dim PossibleWords(9) As String
PossibleWords(0) = "adjacent"
PossibleWords(1) = "ridiculous"
PossibleWords(2) = "necessary"
PossibleWords(3) = "waltz"
PossibleWords(4) = "elephant"
PossibleWords(5) = "zoology"
PossibleWords(6) = "miasma"
PossibleWords(7) = "definition"
PossibleWords(8) = "orange"
PossibleWords(9) = "prevailing"
'get random number
Dim wordNumber As Integer
wordNumber = Int(Math.Rnd() * 10)
WordChosen = PossibleWords(wordNumber)
So when a new object is created based on the clsWord class, the value of the WordChosen property is generated.
The Let part of the WordToGuess property in the clsGame class starts by hiding all other rows and columns:
Property Let WordToGuess(ThisGuessWord As String)
'remember word being guessed
pWordToGuess = ThisGuessWord
Dim WordCount As Integer
WordCount = Len(pWordToGuess)
'hide all other columns and colour word
Range(Cells(1, 1), Cells(1, WordCount)).Name = "Word"
Range(Cells(1, WordCount + 1), _
Range("A1").End(xlToRight)).EntireColumn.Hidden = True
Range(Cells(8, 1), Cells(8, 1).End(xlDown)).EntireRow.Hidden = True
The property then formats this word:
'increase row height and set alignments
.EntireRow.RowHeight = 40
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
'change font and back colour
.Font.Bold = True
.Interior.Color = RGB(240, 240, 240)
'put borders round cells
Dim c As Range
For Each c In Range("Word").Cells
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.EntireColumn.ColumnWidth = 15
Finally, the property creates ranges for the number of correct and incorrect guesses, and for the number of lives left:
Range("B3").Value = "Correct"
Range("B4").Value = "Wrong"
Range("B5").Value = "Left"
Range("A3").Name = "Correct"
Range("A4").Name = "Wrong"
Range("A5").Name = "Left"
Range("C3").Name = "GuessesCorrect"
Range("C4").Name = "GuessesWrong"
Range("C5").Name = "GuessesLeft"
'initially, all letters are guessable
Dim SpacedAlphabet As String
Dim LetterPosition As Integer
SpacedAlphabet = ""
For LetterPosition = 1 To Len(Alphabet)
SpacedAlphabet = SpacedAlphabet & _
Mid(Alphabet, LetterPosition, 1) & " "
Range("GuessesLeft").Value = SpacedAlphabet
Range("Correct").Value = 0
Range("Wrong").Value = 0
Range("Left").Value = MaxGuesses
Back in the main code, we then keep playing the game until we get a result:
'keep playing rounds until status changes
Do Until game.StopGameStatus <> GameInProgress
This uses an enumeration to distinguish between the possible ways in which a game can end:
'possible ways to end game
Public Enum enumStopGameStatus
GameInProgress = 0
UserLost = 1
UserWon = 2
UserKeptGuessingInvalidLetters = 3
The PlayRound method creates a new guess, using the clsGuess class:
'keep asking for guesses
Dim Letter As New clsGuess
'tell this guess what the correct word is
Letter.CorrectWord = pWordToGuess
If Not Letter.IfTooManyGoes Then
'user hasn't guessed any letters - abort
StopGameStatus = UserKeptGuessingInvalidLetters
'see if this letter has already been guessed
If Letter.IfAlreadyGuessed Then
MsgBox "You've already guessed this letter!"
'now we have a valid letter which user hasn't already guessed: see what to do with it
'(first remove from letters left)
If Letter.IfGuessCorrect Then
'if a correct guess, record this, increment count and go on to next one
Range("GuessesCorrect").Value = Range("GuessesCorrect").Value & " " & Letter.LetterGuessed
Range("Correct").Value = Range("Correct").Value + 1
'check word not totally guessed
If IfWordGuessed Then
StopGameStatus = UserWon
MsgBox "Good guess! Letter " & Letter.LetterGuessed & " was in the word.", vbOKOnly + vbExclamation, "Correct guess"
'otherwise, record wrong guess, increment wrong count and add to list of incorrect letters
Range("GuessesWrong").Value = Range("GuessesWrong").Value & " " & Letter.LetterGuessed
Range("Wrong").Value = Range("Wrong").Value + 1
Range("Left") = Range("Left").Value - 1
'if not correct and user has used up all guesses, they're toast
If Range("Left").Value = 0 Then
StopGameStatus = UserLost
'tell user letter was wrong
MsgBox "Sorry: letter " & Letter.LetterGuessed & " is not in the word.", vbOKOnly + vbExclamation, "Wrong guess"
At its heart, the clsGuess class contains a method for displaying an input box repeatedly until a user either types in a letter or gives up:
Private Sub StartGuess()
'this method displays an input box until
'the user guesses a letter or gives up
Dim Letter As String
'maximum number of guesses
Const MaxGuesses As Integer = 3
'number of guess
Dim GuessNumber As Integer
'initially no guesses, and no letter guessed
GuessNumber = 1
LetterGuessed = ""
Do Until Len(LetterGuessed) > 0 Or GuessNumber > MaxGuesses
'ask user to type in letter
Letter = Ucase(InputBox("Think of a letter", _
"Guess", "Type letter here"))
'check if letter one-character and valid
If Len(Letter) <> 1 Then
MsgBox "You must type in one (and only one) letter"
ElseIf InStr(1, Alphabet, Letter) <= 0="">=>Then
MsgBox "Not a valid letter"
'if we get here, it's a valid letter
LetterGuessed = Letter
'make sure we don't loop indefinitely
GuessNumber = GuessNumber + 1
At this point, however, there's no saying whether this letter has already been guessed, or whether it's correct or not. That's taken care of by 3 read-only properties. One property determines whether the maximum number of wrong uses of the InputBox has been exceeded (set to 3 currently):
Public Property Get IfTooManyGoes() As Boolean
'if no guesses yet, start
If LetterGuessed = "" Then StartGuess
'if not letter assigned, too many guesses
IfTooManyGoes = (LetterGuessed <> "")
A second read-only property returns whether the letter the user chose has already been guessed or not, by looping over the letters already guessed and trying to find a match:
Property Get IfAlreadyGuessed() As Boolean
Dim I As Integer
Dim GuessesSoFar As String
'get list of all letters guessed so far (but strip out spaces)
GuessesSoFar = Range("GuessesCorrect").Value & Range("GuessesWrong").Value
GuessesSoFar = Replace(GuessesSoFar, " ", "")
For I = 1 To Len(GuessesSoFar)
'for each letter in the word, see if there's a match
If Mid(GuessesSoFar, I, 1) = LetterGuessed Then
IfAlreadyGuessed = True
'if we get here, the user hasn't guessed this letter
IfAlreadyGuessed = False
A third read-only property then returns whether a letter guessed is correct or not:
Property Get IfGuessCorrect() As Boolean
'finds out if this guess is in word (and along the way uncovers any valid letters in word)
'initially assume not correct guess
IfGuessCorrect = False
Dim I As Integer
Dim c As Range
For I = 1 To Len(CorrectWord)
'if this is one of the letters, "uncover" it and flag fact guess was correct
If Mid(CorrectWord, I, 1) = LetterGuessed Then
Set c = Cells(1, i)
c.Interior.Color = RGB(240, 255, 255)
c.Value = LetterGuessed
IfGuessCorrect = True
Note how I've put the properties where they belong. When you guess a letter, this guess may be a duplicate or incorrect, but these are properties of the guess itself.
For completeness, the clsGame class uses one internal method and one internal function (marked as Private so they don't come up in autocompetion when consuming the class):
Private Sub RemoveLetter(WhichLetter As String)
'remove this letter and the space before it
Range("GuessesLeft").Value = _
Replace(Range("GuessesLeft").Value, " " & WhichLetter, "")
Private Function IfWordGuessed() As Boolean
'check if word completely guessed
Dim c As Range
For Each c In Range("Word")
If c.Value = "" Then
IfWordGuessed = False
'if we get here, none of the letters in the word are blank
IfWordGuessed = True
I could have made the IfWordGuessed function a read-only property instead, but decided that it isn't really a property of a hangman game.
There are 3 possible ways a game can finish: a user not typing in a valid letter, the user winning the game, or the user losing:
Select Case game.StopGameStatus
MsgBox "Congratulations - you've won! The word was " & game.WordToGuess & "."
MsgBox "Sorry - you lost. The word was " & game.WordToGuess & "."
MsgBox "Aborted game"
'shouldn't ever get here
MsgBox "Error in code"
Notice how the enumeration makes the code easier to read. This code calls the StopGameStatus read-only property of the hangman game class:
'the current status of the game
Public StopGameStatus As enumStopGameStatus
Because this status is set by other code in the class, there's no need for a Let and Get clause: just a public variable will do.
Finally, we terminate this game instance, then ask the user if they want to play again:
'ask if wants to play again
If MsgBox("Do you want to play again?", _
vbQuestion + vbYesNo + vbDefaultButton2,
"Play again?") = vbYes Then IfPlayAgain = True
'game over (close workbook on termination event) - another may then restart
Set game = Nothing
Terminating the game will close down its workbook:
Private Sub Class_Terminate()
'on ending the game, we'll close down the workbook
Was the class approach worth it? I have no idea: it depends on you!
Object-orientated programming using class modules is all about experience, so if you want to learn more it's probably time to start practising.
|Parts of this blog|
25 Aytoun Street