时间戳

首页 > 解决方案 > VBA 验证字段和日期/时间

excel - VBA 验证字段和日期/时间

问题描述

我编写了一个为新员工生成文件的宏，我的问题是它没有验证两个字段。CboxCorpName 字段应仅根据在 cboxSite 字段中选择的值进行填充，并且不这样做。此外，我的 cboxHour、cboxMinute 等我想要一个日历和时钟，而不必从我创建的几个下拉菜单中选择日期和时间。曾经有一个可用的日期和时间选择器，但我似乎可以在 Office 365 上找到它。非常感谢任何输入以使此代码看起来更好、更整洁。我为凌乱的代码道歉，但仍然习惯于让它与清洁相反。由于长度限制和公司信息，我删除了一些编码...

在这里，您将找到用户表单和流程的代码。

用户表单：

Private Sub btnOpenFileFormatWorkDay_Click()Dim intChoice As Integer
Dim strFileToOpen As String


Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
intChoice = Application.FileDialog(msoFileDialogOpen).Show


If intChoice <> 0 Then


strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
Me.txtFileFormatWorkDay.Text = strPath
End If
End Sub


Private Sub btnStartProcess_Click()
Dim MyWB As Workbook
If ValidFields = True Then
    Set MyWB = ThisWorkbook
    Call mProcess.CreatePassNewHire(MyWB)
    MsgBox "Se ha generado correctamente el correo y/o los archivos para el nuevo ingreso"
End If
End Sub

Private Sub cboxGenerateContract_Change()
If cboxGenerateContract.Text = "Si" Then
    framnewHireContract.Enabled = True
    LabelContract.Enabled = True

    With Me.cboxCorpName
        .Clear
        On Error Resume Next
        MyWB.Worksheets("Catalogo").ShowAllData
        Set MyWB = ThisWorkbook
        c = MyWB.Sheets("Catalogo").Cells.CurrentRegion.Rows.Count
        For Each rw In MyWB.Sheets("Catalogo").Range("B2:B" & c)
        If rw.row <> 1 Then
            .AddItem MyWB.Sheets("Catalogo").Range("D" & rw.row).Value
        End If
        Next
        MyWB.Worksheets("Catalogo").ShowAllData
     End With
ElseIf cboxGenerateContract.Text = "No" Then
    framnewHireContract.Enabled = False
    LabelContract.Enabled = False
End If
End Sub


Private Sub cboxSite_Change()
Dim c, i As Long
Dim rw As Range
Dim MyWB As Workbook
'If cboxSite <> "" Then
'    With Me.cboxBuilding
'        .Clear
'        On Error Resume Next
'        MyWB.Worksheets("Catalogo").ShowAllData
'        Set MyWB = ThisWorkbook
'        c = MyWB.Sheets("Catalogo").Cells.CurrentRegion.Rows.Count
'        MyWB.Sheets("Catalogo").Range("A1:D1").AutoFilter Field:=1, Criteria1:=cboxSite
'        For Each rw In MyWB.Sheets("Catalogo").Range("B2:B" & c).SpecialCells(xlCellTypeVisible)
'        If rw.row <> 1 Then
'        .AddItem MyWB.Sheets("Catalogo").Range("B" & rw.row).Value
'        End If
'        Next
'        MyWB.Worksheets("Catalogo").ShowAllData
'     End With
'End If
End Sub


Private Sub chkboxViewNewFilePassContract_Click()
If chkboxViewNewFilePassContract.Value = True Then
 txtNewFilePassContract.PasswordChar = ""
ElseIf chkboxViewNewFilePassContract.Value = False Then
 txtNewFilePassContract.PasswordChar = "*"
End If
End Sub


Private Sub UserForm_Initialize()
Dim i As Long
With Me.cboxHour
    .AddItem "HH"
    For i = 1 To 12
    .AddItem i
    Next i
    .Text = "HH"
End With


With Me.cboxMinute
   .AddItem "MM"
   .AddItem "00"
   .AddItem "05"
   .AddItem "10"
   .AddItem "15"
   .AddItem "20"
   .AddItem "25"
   .AddItem "30"
   .AddItem "35"
   .AddItem "40"
   .AddItem "45"
   .AddItem "50"
   .AddItem "55"
   .Text = "MM"
End With


With Me.cboxPeriod
   .AddItem "PM"
   .AddItem "AM"
End With


With Me.cboxGenerateContract
   .AddItem "Si"
   .AddItem "No"
   .Text = "Si"
End With


With Me.cboxNewHireGender
   .AddItem "Femenino"
   .AddItem "Másculino"
End With


With Me.cboxYear
    .AddItem "AA"
    For i = Year(Now) To Year(Now) + 1
    .AddItem i
    Next i
    .Text = "AA"
End With


With Me.cboxMonth
    .AddItem "MM"
    For i = 1 To 12
    .AddItem i
    Next i
    .Text = "MM"
End With


With Me.cboxDay
    .AddItem "DD"
    For i = 1 To 31
    .AddItem i
    Next i
    .Text = "DD"
End With


With Me.cboxSite
   .AddItem "Aguascalientes"
   .AddItem "GDL Norte"
   .AddItem "GDL Sur"
   .AddItem "JRZ Norte"
   .AddItem "JRZ Sur"
   .AddItem "Queretaro"
   .AddItem "Reynosa"
   .AddItem "San Luis Rio Colorado"
   .AddItem "Tijuana"
End With
End Sub


Private Function ValidFields() As Boolean
If Len(txtNewHireName.Text) = 0 Then
    MsgBox "Escribe el nombre del nuevo ingreso", vbCritical, "Error"
    ValidFields = False
    Exit Function
End If
If Len(txtNewHireEmail.Text) = 0 Then
    MsgBox "Escribe el correo personal del nuevo ingreso", vbCritical, "Error"
    ValidFields = False
    Exit Function
End If
If cboxSite.Text = "" Then
    MsgBox "Seleccione el campus del nuevo ingreso", vbCritical, "Error"
    ValidFields = False
    Exit Function
End If


If Len(txtRoom.Text) = 0 Then
    MsgBox "Escribe el nombre de la sala", vbCritical, "Error"
    ValidFields = False
    Exit Function
End If
If Len(txtContactName.Text) = 0 Then
    MsgBox "Escribe el nombre del Contacto del nuevo ingreso", vbCritical, "Error"
    ValidFields = False
    Exit Function
End If
If Len(txtContactPhoneExt.Text) = 0 Then
    MsgBox "Escribe la extensión del Contacto del nuevo ingreso", vbCritical, "Error"
    ValidFields = False
    Exit Function
End If
If IsNumeric(txtContactPhoneExt.Text) = False Then
    MsgBox "Escribe el nombre del Contacto del nuevo ingreso", vbCritical, "Error"
    ValidFields = False
    Exit Function
End If

If cboxYear.Text = "AA" Then
    MsgBox "Seleccione el año de ingreso del nuevo ingreso", vbCritical, "Error"
    ValidFields = False
    Exit Function
End If
If cboxMonth.Text = "MM" Then
    MsgBox "Seleccione el mes de ingreso del nuevo ingreso", vbCritical, "Error"
    ValidFields = False
    Exit Function
End If
If cboxDay.Text = "DD" Then
    MsgBox "Seleccione el día de ingreso del nuevo ingreso", vbCritical, "Error"
    ValidFields = False
    Exit Function
End If
If cboxHour.Text = "HH" Then
    MsgBox "Seleccione la hora de ingreso del nuevo ingresoo", vbCritical, "Error"
    ValidFields = False
    Exit Function
End If
If cboxMinute.Text = "MM" Then
    MsgBox "Seleccione los minutos de ingreso del nuevo ingresoo", vbCritical, "Error"
    ValidFields = False
    Exit Function
End If
If cboxPeriod.Text = "" Then
    MsgBox "Seleccione la periodo de ingreso del nuevo ingresoo", vbCritical, "Error"
    ValidFields = False
    Exit Function
End If


If cboxGenerateContract.Text = "Si" Then
    If Len(txtNewFilePassContract.Text) = 0 Then
        MsgBox "Escribe la contraseña para el contrato del nuevo ingreso", vbCritical, "Error"
        ValidFields = False
        Exit Function
    End If
    If Len(txtNewHireAge.Text) = 0 Then
        MsgBox "Escribe la edad del nuevo ingreso", vbCritical, "Error"
        ValidFields = False
        Exit Function
    End If
    If IsNumeric(txtNewHireAge.Text) = False Then
        MsgBox "La edad del nuevo ingreso debe ser númerica", vbCritical, "Error"
        ValidFields = False
        Exit Function
    End If
    If cboxNewHireGender.Text = "" Then
        MsgBox "Selecciona el genero del nuevo ingreso", vbCritical, "Error"
        ValidFields = False
        Exit Function
    End If


    If Len(txtNewHireRFC.Text) = 0 Then
        MsgBox "Escribe el RFC del nuevo ingreso", vbCritical, "Error"
        ValidFields = False
        Exit Function
    End If
    If Len(txtNewHireRFC.Text) < 13 Then
        MsgBox "El RFC del nuevo ingreso debe de ser de 13 carácteres", vbCritical, "Error"
        ValidFields = False
        Exit Function
    End If
    If Len(txtNewHireRFC.Text) > 13 Then
        MsgBox "El RFC del nuevo ingreso debe de ser de 13 carácteres", vbCritical, "Error"
        ValidFields = False
        Exit Function
    End If
    If Len(txtNewHireCURP.Text) = 0 Then
        MsgBox "Escribe el CURP del nuevo ingreso", vbCritical, "Error"
        ValidFields = False
        Exit Function
    End If
    If Len(txtNewHireCURP.Text) < 18 Then
        MsgBox "El CURP del nuevo ingreso debe de ser de 18 carácteres", vbCritical, "Error"
        ValidFields = False
        Exit Function
    End If
    If Len(txtNewHireCURP.Text) > 18 Then
        MsgBox "El CURP del nuevo ingreso debe de ser de 18 carácteres", vbCritical, "Error"
        ValidFields = False
        Exit Function
    End If
    If Len(txtNewHireAddress.Text) = 0 Then
        MsgBox "Escribe la dirección del nuevo ingreso", vbCritical, "Error"
        ValidFields = False
        Exit Function
    End If
    If Len(txtNewHireColony.Text) = 0 Then
        MsgBox "Escribe la colonia del nuevo ingreso", vbCritical, "Error"
        ValidFields = False
        Exit Function
    End If
    If Len(txtNewHireCity.Text) = 0 Then
        MsgBox "Escribe el municipio del nuevo ingreso", vbCritical, "Error"
        ValidFields = False
        Exit Function
    End If
    If Len(txtJob.Text) = 0 Then
        MsgBox "Escribe el nombre del puesto del nuevo ingreso", vbCritical, "Error"
        ValidFields = False
        Exit Function
    End If


    If txtJobSalary.Text = "" Then
        MsgBox "Escribe el salario del del nuevo ingreso", vbCritical, "Error"
        ValidFields = False
        Exit Function
    End If
End If

ValidFields = True
End Function

标签： excelvbavalidation

解决方案

推荐阅读