Não resolveu, o que ue quero é que apareça a diferença no label9 (que vou criar), da txtHoras - txtSaida
Private Sub cmdAlterar_Click()
lsHabilitar
End Sub
Private Sub cmdAnterior_Click()
Dim currentFind As Range
If IsNumeric(lblCod.Caption) = True Then
Set currentFind = Worksheets("Dados").Range("A:A").Find(lblCod.Caption, , _
Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
If currentFind.Row >= 2 And IsNumeric(Worksheets("Dados").Cells(currentFind.Row - 1, 1)) Then
lsLocalizaRegistroStudent (CLng(Worksheets("Dados").Cells(currentFind.Row - 1, 1)))
End If
Sheets("Menu").Activate
End If
End Sub
Private Sub cmdExcluir_Click()
Dim lLinha As Long
Dim currentFind As Range
Dim lPosicao As String
iTotalLinhas = Sheets("Dados").Cells(Rows.Count, 1).End(xlUp).Row
If IsNumeric(lblCod.Caption) = True Then
Set currentFind = Worksheets("Dados").Range("A:A").Find(lblCod.Caption, , _
Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
lLinha = currentFind.Row
currentFind.EntireRow.Delete
If lLinha <= iTotalLinhas And IsNumeric(Worksheets("Dados").Cells(lLinha - 1, 1)) Then
lsLocalizaRegistroStudent (CLng(Worksheets("Dados").Cells(lLinha - 1, 1)))
End If
If lLinha = 2 And iTotalLinhas > 2 Then
lsLocalizaRegistroStudent (CLng(Worksheets("Dados").Cells(lLinha + 1, 1)))
Else
lsLimparStudents
End If
Sheets("Menu").Activate
End If
Sheets("Menu").Activate
End Sub
Private Sub cmdIncluir_Click()
lsHabilitar
lsLimparStudents
End Sub
Private Sub cmdProximo_Click()
Dim lLinha As Long
Dim currentFind As Range
iTotalLinhas = Sheets("Dados").Cells(Rows.Count, 1).End(xlUp).Row
If IsNumeric(lblCod.Caption) = True Then
Set currentFind = Worksheets("Dados").Range("A:A").Find(lblCod.Caption, , _
Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
If currentFind.Row < iTotalLinhas And IsNumeric(Worksheets("Dados").Cells(currentFind.Row + 1, 1)) Then
lsLocalizaRegistroStudent (CLng(Worksheets("Dados").Cells(currentFind.Row + 1, 1)))
End If
Sheets("Menu").Activate
End If
End Sub
Private Sub cmdSair_Click()
frmRegistoCrimes.Hide
End Sub
Private Sub cmdPrimeiro_Click()
lsLocalizaRegistroStudent (Worksheets("Dados").Cells(2, 1).Value)
Sheets("Menu").Activate
End Sub
Private Sub cmdSalvar_Click()
If txtNOrdem.Enabled = True And lfValidarDados = True Then
If Not IsNumeric(lblCod.Caption) = True Then
lsInserirStudent
Sheets("Menu").Activate
Else
lsAlterarStudent
Sheets("Menu").Activate
End If
lsDesabilitar
MsgBox "Registo Guardado!"
End If
End Sub
Private Sub cmdUltimo_Click()
Dim iTotalLinhas As Long
iTotalLinhas = 999999
lsLocalizaRegistroStudent (iTotalLinhas)
Sheets("Menu").Activate
End Sub
Private Sub txtHoras_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim TimeStr As String
Set TextLength = txtHoras
On Error GoTo EndMacro
With txtHoras
If HasFormula = False Then
Select Case Len(TextLength)
Case 1
TimeStr = "00:0" & TextLength
Case 2
TimeStr = "00:" & TextLength
Case 3
TimeStr = Left(TextLength, 1) & ":" & Right(TextLength, 2)
Case 4
TimeStr = Left(TextLength, 2) & ":" & Right(TextLength, 2)
'Case 5 ' ex: 12345 = 01:23:45
' TimeStr = Left(TextLength, 1) & ":" & Mid(TextLength, 2, 2) & ":" & Right(TextLength, 2)
'Case 6 ' ex: 123456 = 12:34:56
' TimeStr = Left(TextLength, 2) & ":" & Mid(TextLength, 3, 2) & ":" & Right(TextLength, 2)
Case Else
MsgBox "HORA EM BRANCo !!!"
'With TextBox1
' .SetFocus
'.SelStart = 0
'.SelLength = Len(.Text)
' End With
Exit Sub
End Select
Application.EnableEvents = False
Formula = TimeValue(TimeStr)
txtHoras = TimeStr
sCancel = False
End If
End With
GoTo Fim
EndMacro:
MsgBox "HORA Inválida !!!"
With txtHoras
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
sCancel = True
Fim:
Application.EnableEvents = True
End Sub
Private Sub txtHoras_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Limita a Qde de caracteres
txtHoras.MaxLength = 4
Select Case KeyAscii
Case 8, 48 To 57 ' BackSpace e numericos
'If Len(txtHoras) = 2 Or Len(txtHoras) = 6 Then
' txtHoras.Text = txtHoras.Text & ":"
SendKeys "{End}", False
' End If
Case Else ' o resto é travado
KeyAscii = 0
End Select
End Sub
Private Sub txtSaida_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim TimeStr As String
Set TextLength = txtSaida
On Error GoTo EndMacro
With txtSaida
If HasFormula = False Then
Select Case Len(TextLength)
Case 1
TimeStr = "00:0" & TextLength
Case 2
TimeStr = "00:" & TextLength
Case 3
TimeStr = Left(TextLength, 1) & ":" & Right(TextLength, 2)
Case 4
TimeStr = Left(TextLength, 2) & ":" & Right(TextLength, 2)
'Case 5 ' ex: 12345 = 01:23:45
' TimeStr = Left(TextLength, 1) & ":" & Mid(TextLength, 2, 2) & ":" & Right(TextLength, 2)
'Case 6 ' ex: 123456 = 12:34:56
' TimeStr = Left(TextLength, 2) & ":" & Mid(TextLength, 3, 2) & ":" & Right(TextLength, 2)
Case Else
MsgBox "HORA EM BRANCo !!!"
'With TextBox1
' .SetFocus
'.SelStart = 0
'.SelLength = Len(.Text)
' End With
Exit Sub
End Select
Application.EnableEvents = False
Formula = TimeValue(TimeStr)
txtSaida = TimeStr
sCancel = False
End If
End With
GoTo Fim
EndMacro:
MsgBox "HORA Inválida !!!"
With txtSaida
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
sCancel = True
Fim:
Application.EnableEvents = True
End Sub
Private Sub txtSaida_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Limita a Qde de caracteres
txtHoras.MaxLength = 4
Select Case KeyAscii
Case 8, 48 To 57 ' BackSpace e numericos
'If Len(txtSaida) = 2 Or Len(txtSaida) = 6 Then
' txtSaida.Text = txtSaida.Text & ":"
SendKeys "{End}", False
' End If
Case Else ' o resto é travado
KeyAscii = 0
End Select
End Sub
Private Sub UserForm_Initialize()
Call Empresa
End Sub
Sub Empresa()
Me.ComboBox1.Clear
Dim OCOLLECTION As New Collection
Dim VARVALUE As Variant
Dim I, ULTLINHA As Long
ULTLINHA = Folha1.Range("D500").End(xlUp).Row
On Error Resume Next
For Each VARVALUE In Folha1.Range("D2:d" & ULTLINHA)
'Carrega somente Textos
'OCOLLECTION.Add VARVALUE, VARVALUE
'Carrega Textos e Numeros ou só numeros e Textos
OCOLLECTION.Add CStr(VARVALUE), CStr(VARVALUE)
Next
For I = 1 To OCOLLECTION.Count
ComboBox1.AddItem OCOLLECTION.Item(I)
Next
End Sub
Private Sub ComboBox1_Change()
On Error Resume Next
txtMatCivil = Application.WorksheetFunction.VLookup(CStr(ComboBox1), Folha1.Range("D1:f500"), 2, 0) '=PROCV(H2;A1:B3;2;0)
txtOrgao = Application.WorksheetFunction.VLookup(CStr(ComboBox1), Folha1.Range("D1:f500"), 3, 0) '=PROCV(H2;A1:B3;2;0)
[Folha1!T22].Value = txtMatOrgao.Value
[Folha1!U22].Value = txtMatCivil.Value
End Sub
Private Sub txtMatCivil_Change()
End Sub
Private Sub txtNOrdem_Change()
On Error Resume Next
txtNome = Application.WorksheetFunction.VLookup(CDbl(txtNOrdem), Folha1.Range("A1:B204"), 2, 0) '=PROCV(H2;A1:B3;2;0)
[Folha1!Q22].Value = txtNome.Value
[Folha1!R22].Value = txtNOrdem.Value
End Sub
Private Sub txtDataSitrep_Exit(ByVal Cancel As MSForms.ReturnBoolean)
txtDataSitrep = Format(txtDataSitrep, "dd/mm/yyyy")
Cancel = False
End Sub
Private Sub txtDataOcorrencia_Exit(ByVal Cancel As MSForms.ReturnBoolean)
txtDataOcorrencia = Format(txtDataOcorrencia, "dd/mm/YYYY")
Cancel = False
End Sub
Private Sub UserForm_Activate()
lsLocalizaRegistroStudent (Worksheets("Dados").Cells(2, 1).Value)
Sheets("Menu").Activate
End Sub