Игра «Угадай животное»

Листинг 6.4.Игра «Угадай животное»

Sub StartGame()

Dim intLastRow As Integer ' Номер строки для вставки записей

Dim intRow As Integer ' Номер текущей строки

Dim intYesRow As Integer ' Номер строки, из которой брать _

данные при утвердительном ответе

Dim intNoRow As Integer ' Номер строки, из которой брать _

данные при отрицательном ответе

Dim strText As String ' Строка с вопросом или названием _

животного

Dim strNewName As String ' Строка с названием нового животного

Dim strNewQuestion As String ' Строка с новым вопросом

Dim intRes As Integer

' Начало игры

MsgBox "Начнем игру. Задумайте животное.", vbOKOnly, _

"Задумайте животное"

' Определение номера ряда для вставки записей. _

intLastRow-1 - номер последнего ряда, содержащего данные

intLastRow = Worksheets("Data").Range("D1").Value + 1

' Данные в таблице идут с первого ряда

intRow = 1

Do While intRow < intLastRow

' Текст вопроса или название животного из столбца "A"

strText = Worksheets("Data").Cells(intRow, 1).Value

' Номер ряда, из которого брать данные при утвердительном _

ответе, берем из столбца "B"

intYesRow = Worksheets("Data").Cells(intRow, 2).Value

' Номер ряда, из которого брать данные при отрицательном _

ответе, берем из столбца "C"

intNoRow = Worksheets("Data").Cells(intRow, 3).Value

If intYesRow > 0 Then

' В строке strText содержится вопрос. Зададим его

intRes = MsgBox(strText, vbYesNo, "Вопрос")

If intRes = vbYes Then

' Переходим по утвердительному ответу

intRow = intYesRow

Else

' Переходим по отрицательному ответу

intRow=intNoRow

EndIf

Else

' Альтернативы закончились. В строке strText - название _

животного. Спросим, его ли загадали

intRes = MsgBox("Это " & strText & "?", vbYesNo, "Вопрос")

If intRes = vbYes Then

' Животное угадано

MsgBox "Угадано! Спасибо за игру!", vbOKOnly, _

"Игра завершена"

Exit Do

Else

' Животное не угадали, но данные уже занкончились. _

Нужно пополнить наши данные, чтобы отличать животное _

с названием strText от загаданного

' Ввод названия нового животного

strNewName = InputBox("Сдаюсь. Кто это?", _

"Напечатайте название животного")

If strNewName <> "" Then

' Ввод вопроса, по которому отличать животных

strNewQuestion = InputBox("Задайте вопрос, по " & _

"которому можно отличить '" & strNewName & _

"' от '" & strText & "'", "Напечатайте вопрос")

If strNewQuestion <> "" Then

' Определение, какое из животных соответствует _

утвердительному ответу на вопрос

intRes = MsgBox("Правильный ответ на ваш " & _

"вопрос - " & strNewName & "'", vbYesNo, _

"Какой ответ на вопрос?")

' Добавление в таблицу названия нового животного

Worksheets("Data").Cells(intLastRow, 1). _

Value = strNewName

' Перемещения названия животного, которое было _

ранее, в конец таблицы

Worksheets("Data").Cells(intLastRow + 1, 1). _

Value = strText

' Замена названия этого животного вопросом

Worksheets("Data").Cells(intRow, 1). _

Value = strNewQuestion

' Корректировка номеров строк для перехода _

в зависимости от того, какое животное является _

правильным ответом на введенный пользователем вопрос

If intRes = vbYes Then

' Новое животное - правильный ответ

Worksheets("Data").Cells(intRow, 2). _

Value = intLastRow

Worksheets("Data").Cells(intRow, 3). _

Value = intLastRow + 1

Else

' Бывшее ранее животное - правильный ответ

Worksheets("Data").Cells(intRow, 2). _

Value = intLastRow + 1

Worksheets("Data").Cells(intRow, 3). _

Value = intLastRow

End If

' Сохраним номер строки для добавления записей

Worksheets("Data").Range("D1").Value = _

intLastRow + 2

End If

End If

' Игра завершена. Таблица дополнена

MsgBox "Спасибо за игру!", vbOKOnly, "Игра завершена"

Exit Do

End If

End If

Loop

End Sub