Готовые макросы в VBA Excel (Миронов.) (z-lib.org). Запуск макроса с поиском ячейки 6 Запуск макроса при открытии книги 6
 Скачать 1.47 Mb.
|
Игра «Угадай животное»Листинг 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 End If 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 |