Boa tarde, eu estou recebendo um erro que me retorna a mensagem para adicionar um End Sub, porém se eu adicionar esse End Sub ele ficará no meio do código.
Segue o código abaixo:
Private Sub btnAgendar_Click()
Dim idHora As Long
linha = IIf(Sheets("Base").Range("AgendadordeEventos").Cells(1, 1) = "", 3, Sheets("Base").Range("AgendadordeEventos").Cells(0, 1).End(4).Row + 1)
idHora = Me.cboHora.ListIndex
'Nova rotina para validar agendamento
Call validaAgendamento(CStr(Me.txtData), CStr(Me.cboHora))
If existeAgendamento = True Then
MsgBox "Data e Hora já utilizados em outro agendamento!", vbExclamation, "Erro"
Exit Sub
End If
'Para que a data entre como texto, formate a coluna como GERAL
'pois a linha abaixo insere o valor como TEXTO( String )
Sheet3.Cells(linha, 5).Value = CDate(Me.txtData.Value)
'Aqui inserimos valor com formato de Hora:Minutos
Sheet3.Cells(linha, 6).Value = Format(Me.cboHora.Value, "hh:mm")
Sheet3.Cells(linha, 7).Value = UCase(Me.txtNome.Value)
Sheet3.Cells(linha, 8).Value = UCase(Me.txtRamal.Value)
Sheet3.Cells(linha, 9).Value = UCase(Me.txtAssunto.Value)
'Columns.AutoFit
MsgBox "Agendamento concluído", vbInformation, "Agendamento de Reunião"
Me.txtData.Value = ""
'Se desejar remover o horário cadastrado da lista
'descomente a linha abaixo
'Me.cboHora.RemoveItem Me.cboHora.ListIndex
Me.txtNome.Value = ""
Me.cboHora.Value = ""
Me.txtRamal.Value = ""
Me.txtAssunto.Value = ""
End Sub
Private Sub TextBox2_Change()
End Sub
Private Sub btnSair_Click()
Unload frmAgendamentoCGH
End Sub
Private Sub cbHora_Change()
End Sub
Private Sub cboHora_Change()
End Sub
Private Sub Image1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
End Sub
Private Sub txtData_Change()
End Sub
Private Sub txtData_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
txtData = Format(txtData, "@@/@@/@@@@")
End If
End Sub
Private Sub txtHora_Change()
End Sub
Private Sub txtHora_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
txtHora = Format(txtHora, "@@:@@")
End If
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub UserForm_Initialize()
Dim existeAgendamento As Boolean
With cboHora
.Style = fmStyleDropDownCombo
.Clear
For vLinha = 3 To ThisWorkbook.Sheets("Intervalo").Cells(Rows.Count, 5).End(xlUp).Row - 1
If ThisWorkbook.Sheets("Intervalo").Cells(vLinha, 5) <> "" Then
.AddItem ThisWorkbook.Sheets("Intervalo").Cells(vLinha, 5).Text
End If
Next
.Style = fmStyleDropDownList
.ListIndex = 0
End With
'Adicionando código para condição de agendamento
Function validaAgendamento(ByVal Data As String, ByVal Hora As String)
existeAgendamento = False
With ThisWorkbook.Sheets3("Base")
Dim vData As String, vHora As String
Dim linhaAtual As Long
linhaAtual = 3
Do
vData = CStr(.Cells(linhaAtual, 5))
vHora = Format(.Cells(linhaAtual, 6), "h:mm")
If vData = CStr(Data) Then
If vHora = CStr(Hora) Then
existeAgendamento = True
Exit Do
End If
End If
linhaAtual = linhaAtual + 1
Loop While .Cells(linhaAtual, 5) <> "" 'linhaAtual <= linhaFinal
End With
End Function
End Sub
Qual seria o local correto para adicionar os códigos no UserForm?
Postado : 22/10/2019 11:43 am