Непосредственный ввод данных

Ввод данных с помощью диалогового окна

Ввод строго ограниченных значений в указанный диапазон

Листинг 2.37. Настройка ввода данных в диалоговом окне

Sub DialogInputData()

Dim intMin As Integer, intMax As Integer ' Диапазон значений

Dim strInput As String ' Введенная пользователем строка

Dim strMessage As String

Dim intValue As Integer

intMin = 1 ' Минимальное значение

intMax = 50 ' Максимальное значение

strMessage = "Введите значение от " & intMin & " до " & intMax

' Ввод значения (цикл завершается, когда пользователь вводит _

значение из заданного диапазона или отменяет ввод)

Do

strInput = InputBox(strMessage)

If strInput = "" Then Exit Sub ' Отмена ввода

' Проверка, содержит ли введенная пользователем строка число

If IsNumeric(strInput) Then

intValue = CInt(strInput)

' Проверка, удовлетворяет ли значение диапазону

If intValue >= intMin And intValue <= intMax Then

' Все условия выполнены

Exit Do

End If

End If

' Формирование сообщения с текстом ошибки

strMessage = "Вы ввели некорректное значение." & vbNewLine & _

"Введите число от " & intMin & " до " & intMax

Loop

' Внесение данных в ячейку

ActiveSheet.Range("A1").Value = strInput

End Sub

Листинг 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

Дата добавления: 2015-06-25