![]() Главная страница Случайная страница КАТЕГОРИИ: АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника |
Непосредственный ввод данных
Листинг 2.38. Ограничение возможных значений диапазона Sub Worksheet_Change(ByVal Target As Excel.Range) Dim rgInputRange As Range Dim cell As Range Dim strMessage As String Dim varResult As Variant
' Диапазон, в котором контролируется ввод Set rgInputRange = Range(" A1: E10") ' Просмотр всех измененных ячеек и контроль ввода в тех, которые _ принадлежат заданному диапазону For Each cell In Target ' Проверка принадлежности диапазону If Union(cell, rgInputRange).Address = rgInputRange.Address Then ' Контроль правильности ввода varResult = IsCellDataValid(cell) If varResult = True Then ' Введено корректное значение Exit Sub Else ' Формирование и вывод сообщения об ошибке strMessage = " Ячейка " & cell.Address(False, False) & ": " _ & vbCrLf & vbCrLf & varResult MsgBox strMessage, vbCritical, " Неправильное значение" ' Очистка ввода Application.EnableEvents = False cell.ClearContents cell.Activate Application.EnableEvents = True End If End If Next cell End Sub
Function IsCellDataValid(cell As Range) As Variant ' Возвращает True, если в ячейку вводится целое число _ в диапазоне от 1 до 12. В противном случае выдается _ соответствующее сообщение
' Проверка, является ли содержимое ячейки числом If Not WorksheetFunction.IsNumber(cell.Value) Then IsCellDataValid = " Нечисловое значение" Exit Function End If ' Проверка, является ли введенное число целым If Int(cell.Value) < > cell.Value Then IsCellDataValid = " Введите целое число" Exit Function End If ' Проверка соответствия числа диапазону If cell.Value < 1 Or cell.Value > 12 Then IsCellDataValid = " Значение должно быть от 1 до 12" Exit Function End If
' В ячейку введено допустимое значение IsCellDataValid = True End Function Последовательный ввод данных Листинг 2.39. Последовательный ввод данных Sub StreamInput() Dim strDate As String Dim strSum As String Dim lngRow As Long ' Ввод данных в цикле (повторяется до тех пор, пока пользователь _ не введет пустую строку или не нажмет " Отмена" в окне ввода) Do lngRow = Range(" A65536").End(xlUp).Row + 1 ' Ввод даты strDate = InputBox(" Вводим дату") If strDate = " " Then Exit Sub ' Ввод выручки strSum = InputBox(" Вводим выручку") If strSum = " " Then Exit Sub ' Запись данных в ячейки Cells(lngRow, 1) = strDate Cells(lngRow, 2) = strSum Loop End Sub
|