Подтвердить ввод текстового поля

Я создал пользовательскую форму в Excel и имею диапазон для проверки данных.

Я хочу проверить ввод пользователя, прежде чем пользователь нажмет кнопку «Сохранить».

Пример: ввод значения «x», если 1 <= x <= 10, текстовое поле «Данные» будет помечено красным цветом и появится всплывающее сообщение «Вне контроля», форма попросит пользователя продолжить ввод в текстовое поле «Повторно протестировать» в пределах диапазона данных (в Эксель-файл).

Вот мой код и вложенный файл, также http://www.mediafire.com/view/fl1nk84nu62wg34/Control_Chart.xlsm

Private Sub cbCa_DropButtonClick()
    cbCa.AddItem ("Ca 1")
    cbCa.AddItem ("Ca 2")
    cbCa.AddItem ("Ca 3")
    cbCa.AddItem ("")
End Sub

Private Sub cbType_DropButtonClick()
    cbType.AddItem ("Set Up")
    cbType.AddItem ("Production")
End Sub

Private Sub CommandButton1_Click()
    'Copy input values to sheet.
    Dim lRow As Long
    Dim ws As Worksheet

    Set ws = Worksheets("Input Data")
    lRow = ws.Cells(Rows.Count, 8).End(xlUp).Offset(1, 0).Row
    With ws
        .Cells(lRow, 2).Value = Me.txNgay.Value
        .Cells(lRow, 3).Value = Me.txGio.Value
        .Cells(lRow, 4).Value = Me.cbCa.Value
        .Cells(lRow, 5).Value = Me.txNV.Value
        .Cells(lRow, 6).Value = Me.txSolo.Value
        .Cells(lRow, 7).Value = Me.txMa.Value
        .Cells(lRow, 8).Value = Me.txData.Value
        .Cells(lRow, 9).Value = Me.txReTest.Value
        .Cells(lRow, 10).Value = Me.txLydo.Value
        .Cells(lRow, 11).Value = Me.cbType.Value
    End With

       'Hien thong bao nhac nho
If txNgay.Text = "" Then
        MsgBox "Quen cho ngay kia thim", vbOKOnly + vbInformation, 
                 "THÔNG BÁO"

    txNgay.BackColor = &HFF& ' change the color of the textbox

    ElseIf txGio.Text = "" Then
        MsgBox "Quen nhap gio kia thim", vbOKOnly + vbInformation, 
                  "THÔNG BÁO"

        txGio.BackColor = &HFF& ' change the color of the textbox

    ElseIf txNV.Text = "" Then
        MsgBox "Ten cua thim la gi vay", vbOKOnly + vbInformation, 
                 "THÔNG BÁO"

        txNV.BackColor = &HFF& ' change the color of the textbox

    ElseIf txMa.Text = "" Then
        MsgBox "Quen nhap Ma san pham kia thim", vbOKOnly + vbInformation, 
                  "THÔNG BÁO"

        txMa.BackColor = &HFF& ' change the color of the textbox

    ElseIf txSolo.Text = "" Then
        MsgBox "Quen nhap So lo kia thim", vbOKOnly + vbInformation, "THÔNG 
                  BÁO"

        txSolo.BackColor = &HFF& ' change the color of the textbox

    ElseIf txData.Text = "" Then
        MsgBox "Quen nhap data kia thim", vbOKOnly + vbInformation, "THÔNG 
                  BÁO"

        txData.BackColor = &HFF& ' change the color of the textbox

    End If

    ThisWorkbook.Save

    '    End If

End Sub

Private Sub CommandButton2_Click()
 'Clear input controls.
    Me.txNgay.Value = ""
    Me.txGio.Value = ""
    Me.cbCa.Value = ""
    Me.txNV.Value = ""
    Me.txSolo.Value = ""
    Me.txMa.Value = ""
    Me.txData.Value = ""
    Me.txLydo.Value = ""

End Sub

Private Sub CommandButton3_Click()
  'Close UserForm.
    Unload Me
End Sub

Private Sub CommandButton4_Click()
ThisWorkbook.Sheets("Control_Chart").Visible = True
ThisWorkbook.Sheets("Control_Chart").Select
UserForm1.Hide
End Sub

Private Sub CommandButton5_Click()
Calendar1.Visible = True
End Sub

Private Sub Label15_Click()
Label15.Caption = Sheet2.Range("F2").Value
End Sub

Private Sub Label16_Click()
Label16.Caption = Sheet2.Range("F4").Value
End Sub

Private Sub Label17_Click()
Label17.Caption = Sheet2.Range("F3").Value
End Sub

Private Sub Label18_Click()
Label18.Caption = Sheet2.Range("F6").Value
End Sub

Private Sub Label20_Click()
Label20.Caption = Sheet2.Range("F5").Value
End Sub

Private Sub Label23_Click()

End Sub

Private Sub Label8_Click()
Range("F2").Select
End Sub

Public iDate As Long
Private Sub Calendar1_Click()
  iDate = Calendar1.Value
  txNgay.Value = Format(iDate, "dd/mm/yyyy")
  Calendar1.Visible = False
End Sub

Private Sub txData_Enter()
With Me.txData
        If .Value >= 0.315 Or .Value <= 0.33 Then
            .Value = ""
            MsgBox prompt:="Must be a # between 1 and 30000!", 
                Buttons:=vbCritical, Title:="Invalid Entry"
            Cancel = True
       End If
    End With
End Sub

Private Sub txData_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
 If InStr("1234567890." + Chr$(vbKeyBack), Chr$(KeyAscii)) = 0 Then
  KeyAscii = 0
 End If
End Sub

Private Sub txMa_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
 If InStr("1234567890." + Chr$(vbKeyBack), Chr$(KeyAscii)) = 0 Then
  KeyAscii = 0
 End If
End Sub


Private Sub UserForm_Initialize()
  Calendar1.Visible = False
    Label15.Visible = True
    Label16.Visible = True
    Label17.Visible = True
    Label18.Visible = True
    Label20.Visible = True
End Sub

Загрузить прикрепленный файл

Вот мой обновленный код

'Khai bao bien Data khi nguoi dung nhap lieu
Private Sub txData_AfterUpdate()
Dim x As Double 'Bien do so nhi phan
Dim F2 As Double
Dim F3 As Double
Dim F4 As Double
Dim F5 As Double
Dim F6 As Double

x = Me.txData.Value ' Set gia tri cho bien
F2 = Sheet2.Range("F2").Value
F3 = Sheet2.Range("F3").Value
F4 = Sheet2.Range("F4").Value
F5 = Sheet2.Range("F5").Value
F6 = Sheet2.Range("F6").Value

'Kiem tra hop Data Input co trong hay khong
    If Me.txData = Empty Then
        MsgBox "Please input your data", vbCritical
        txData.BackColor = &HFF& ' change the color of the textbox

        ' Kiem tra hop Data Input co phai la so hay khong
        ElseIf Not IsNumeric(Me.txData) Then
        MsgBox "Numberic only", vbCritical
        txData.BackColor = &HFF& ' change the color of the textbox
        Else
        'Xet dieu kien nguoi dung nhap vao
        Select Case x
            Case x = 0
                MsgBox "Data sao bang 0 duoc", vbCritical
                txData.BackColor = &HFF& ' change the color of the textbox
                txData.SetFocus
             Case Is < F6
                MsgBox "Lower Out of Control. Ban hay nhap gia tri vao o Re Test", vbCritical
                txData.BackColor = &HFF& ' change the color of the textbox
                txReTest.SetFocus
             Case Is > F4
                MsgBox "Upper Out of Control. Ban hay nhap gia tri vao o Re Test", vbCritical
                txData.BackColor = &HFF& ' change the color of the textbox
                txReTest.SetFocus
             Case F5
                MsgBox "Database is correct", vbInformation
                End Select
        ThisWorkbook.Save
    End If

End Sub

excel vba
person Diep Long    schedule 16.01.2016    source источник

Ответы (1)


arrow_upward
0
arrow_downward

Поскольку вы устанавливаете x в значение текстового поля, вам не нужны операторы if в случае выбора.

Select Case x
    Case 0.3
        MsgBox "Correct"
    Case Is < 0.3
        MsgBox "Lower limit"
    Case Is > 0.3
        MsgBox "Upper Limit"
End Select

Обратите внимание, что ограничения, которые я использовал, не обязательно соответствуют вашим ограничениям.

Чтобы проверить текстовое поле, вы можете написать подпрограмму afterupdate, которая срабатывает, когда вы отменяете выбор текстового поля, например, нажимая клавишу табуляции. Это может выглядеть примерно так, как показано ниже, имейте в виду, что вы либо пишете подпрограмму для каждого ввода, который хотите проверить, если у вас много похожих вводов, вы можете написать приватную подпрограмму, которая вызывается из подпрограммы afterupdate, которая проверяет, является ли значение текстового поля числовым и находится ли оно в пределах определенных параметров.

Private Sub txNgay_AfterUpdate()
    If Me.txNgay = Empty Then
        'Code which sets the the look of textbox back to normal.
    ElseIf Not IsNumeric(Me.txNgay) Then
        MsgBox "The textbox doesn't contain a numerical value.", vbCritical
        'Code which sets the look of the textbox to a faulty state
    ElseIf Me.txNgay < 1 Or Me.txNgay > 10 Then
        MsgBox "The value is out of range"
        'Code which sets the look of the textbox to a faulty state
    Else
        'Code which sets the look of the textbox to a normal state
    End If
End Sub

Вы могли бы даже включить в модуль частную подпрограмму, которая вызывается каждый раз при обновлении поля, проверяет все входные данные и активирует кнопку OK только тогда, когда все условия выполнены.

вы можете использовать case select для выполнения кода на основе значений

Select Case x
    Case 0
        'Code to perform the actions you need if x is 0
    Case 1 To 10
        'Code to perform the actions you need if x is between 1 and 10
    Case Else
        'Code to perform the actions you need if x is < 0 and x > 10
End Select
person SilentRevolution    schedule 17.01.2016
comment
Спасибо за ваш ответ и помогите мне SilentRevolution. Я буду объединять каждое текстовое поле с событием AfterUpdate. Для проверки текстового поля данных условием проверки является 1‹x‹10, равное Out of control. Но когда пользователь вводит 0 или любое число, также вызывается сообщение Msgbox. Помогите мне, пожалуйста... - person Diep Long; 17.01.2016
comment
вы можете что-то сделать с Case Select, я добавлю это к ответу. - person SilentRevolution; 17.01.2016
comment
с txData.value = x вы устанавливаете значение текстового поля на значение x, чтобы установить значение переменной x, вам нужно x = txData.value. Целое число x имеет значение по умолчанию 0 при запуске программы, поскольку переменная фактически не изменяется, всегда выбирается Case 0. - person SilentRevolution; 17.01.2016
comment
Спасибо за вашу рекомендацию @SilentRevolution. Я следую вашему руководству и использую Select Case. Я назвал Dim x как Integer и предоставил txData.Value = x для установки переменной. Затем в Select Case и сравните значение при вводе пользователем в txData. Теперь код был изменен. Любое значение, которое я ввел, всегда всплывает в MsgBox Upper Out of control, но для значения 0 (ноль) все в порядке. Пожалуйста, потратьте немного, чтобы просмотреть мой код в области вопросов. - person Diep Long; 17.01.2016
comment
Да, я изменил Dim x на Double, а также отредактировал x = txData.Value. Теперь в Select Case все работает гладко. Очень ценю, SilentRevolution, ты мой учитель в vba. - person Diep Long; 17.01.2016
comment
Я все же хотел бы предложить изменить выбор случая, если он используется правильно, он заменяет операторы if, которые у вас есть на данный момент. - person SilentRevolution; 17.01.2016
comment
Это была замечательная идея, @SilentRevolution. Поскольку я только начинаю изучать VBA, мне повезло, что ты мой наставник. Я редактирую код, удаляю if statement, использую динамическое значение (см. обновленную область моих вопросов). И это работает отлично. Еще раз спасибо. - person Diep Long; 18.01.2016