Поля проверки VBA и дата / время - PullRequest
Новая
       0

Поля проверки VBA и дата / время

0 голосов
/ 14 октября 2019

Я запрограммировал макрос, который генерирует файлы для новых сотрудников, моя проблема в том, что он не проверяет два поля. Поле 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...