Bom dia Pessoal,
Estou finalizando meu formulário de pesquisa mas estou com um problema que é, diga-se de passagem, bem incomodo. Neste formulário tenho dois textbox para inserção da data inicial e da data final de pesquisa.
Meu problema é que quando começo a digitar as datas pelo teclado numérico o NumLock desativa e tenho que ficar habilitando-o novamente para terminar de inserir a data.
Esta desativação costuma acontecer depois dos dois primeiros dígitos quando a primeira "/" é inserida.
Então eu gostaria de saber se existe alguma forma de manter o NumLock sempre ativo e impedir sua desativação e como posso integrar isso ao meu projeto.
O código do formulário segue abaixo:
Private Const NomePlanSaida As String = "Dados"
Private Const NomePlanRelatorio As String = "DadosTemp"
Private Const LinhaCabecalho As Integer = 1
'INICIO EVENTOS FORMATAÇÃO DOS TEXTBOX DATAS'
Private Sub dataf_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Limita a Qde de caracteres'
dataf.MaxLength = 10
'para permitir que apenas números sejam digitados'
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0
End If
End Sub
Private Sub dataf_Change()
'Formata : dd/mm/aaaa'
If Len(dataf) = 2 Or Len(dataf) = 5 Then
dataf.Text = dataf.Text & "/"
SendKeys "{End}", True
End If
End Sub
Private Sub datai_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Limita a Qde de caracteres'
datai.MaxLength = 10
'para permitir que apenas números sejam digitados'
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0
End If
End Sub
Private Sub datai_Change()
'Formata : dd/mm/aaaa'
If Len(datai) = 2 Or Len(datai) = 5 Then
datai.Text = datai.Text & "/"
SendKeys "{End}", True
End If
End Sub
'FIM EVENTOS FORMATAÇÃO DOS TEXTBOX DATAS'
Private Sub UserForm_Activate()
'Define algumas propriedades do ListView'
With Me.lstLista
.Gridlines = True
.HideColumnHeaders = False
.View = lvwReport
End With
'Preenche Combo Box'
setor.AddItem ""
setor.AddItem "Administração"
setor.AddItem "CD 2"
setor.AddItem "HPBE"
setor.AddItem "Logistica"
setor.AddItem "Manutenção"
setor.AddItem "Meio Ambiente"
setor.AddItem "PCP"
setor.AddItem "Qualidade"
setor.AddItem "Segurança"
setor.AddItem "SMBE"
setor.ListIndex = 0
validacao.AddItem ""
validacao.AddItem "Aprovado"
validacao.AddItem "Banco de Ideias"
validacao.AddItem "Aguardando análise da Comissão"
validacao.ListIndex = 0
'Chama a sub para preencher a ListView'
Call LoadListView
End Sub
Sub RestauraControles()
datai.Value = ""
dataf.Value = ""
nome.Value = ""
setor.ListIndex = 0
Call LoadListView
nome.SetFocus
End Sub
Private Sub limpa_Click()
RestauraControles
End Sub
Private Sub fechar_Click()
Unload cmsPesquisa
End Sub
'Preenche a ListView'
Private Sub LoadListView()
Dim ws As Worksheet
Dim coluna As Integer
Dim linha As Integer
Dim itm As ListItem, n As Long, lngCol As Long
Dim vardata As Variant
Set ws = ThisWorkbook.Worksheets(NomePlanSaida)
coluna = 1
linha = LinhaCabecalho
Me.lstLista.ListItems.Clear
Me.lstLista.ColumnHeaders.Clear
vardata = ws.Range("A1").CurrentRegion.Value
With ws
While .Cells(linha, coluna).Value <> Empty
With lstLista
.View = lvwReport
.Gridlines = True
.ColumnHeaders.Add Text:=ws.Cells(linha, coluna), Width:=ws.Cells(linha, coluna).Width
End With
coluna = coluna + 1
Wend
'Preenche as Linhas'
With lstLista
For n = 2 To UBound(vardata)
Set itm = .ListItems.Add(n - 1, , vardata(n, 1))
For lngCol = 2 To UBound(vardata, 2)
'verifica se é Data e formata a Coluna'
If IsDate(vardata(n, lngCol)) Then
itm.ListSubItems.Add , , Format(vardata(n, lngCol), "dd/mm/yyyy")
Else
itm.ListSubItems.Add , , vardata(n, lngCol)
End If
Next lngCol
Next n
End With
End With
End Sub
'Consulta Nome'
Sub nome_Change()
lastRow = Plan2.Cells(Rows.Count, "a").End(xlUp).Row
lstLista.ListItems.Clear
'Adiciona itens'
For x = 2 To lastRow
If UCase(Plan2.Cells(x, 2)) Like "*" & UCase(nome) & "*" Then
Set li = lstLista.ListItems.Add(Text:=Plan2.Cells(x, "a").Value)
li.ListSubItems.Add Text:=Plan2.Cells(x, "b").Value
li.ListSubItems.Add Text:=Plan2.Cells(x, "c").Value
li.ListSubItems.Add Text:=Plan2.Cells(x, "d").Value
li.ListSubItems.Add Text:=Plan2.Cells(x, "e").Value
li.ListSubItems.Add Text:=Plan2.Cells(x, "f").Value
li.ListSubItems.Add Text:=Plan2.Cells(x, "g").Value
li.ListSubItems.Add Text:=Plan2.Cells(x, "h").Value
li.ListSubItems.Add Text:=Plan2.Cells(x, "i").Value
li.ListSubItems.Add Text:=Plan2.Cells(x, "j").Value
li.ListSubItems.Add Text:=Plan2.Cells(x, "k").Value
li.ListSubItems.Add Text:=Plan2.Cells(x, "l").Value
li.ListSubItems.Add Text:=Plan2.Cells(x, "m").Value
End If
Next
End Sub
'Filtrar pelas Datas'
Private Sub cbtSo2Dts_Click()
Dim I As Long
If datai = "" Then
MsgBox "Digite uma Data Valida", , "Data Inicial Obrigatória!!!"
datai.SetFocus
Exit Sub
End If
For I = lstLista.ListItems.Count To 1 Step -1
If CDate(lstLista.ListItems(I).SubItems(5)) < datai.Value Then
lstLista.ListItems.Remove I
ElseIf CDate(lstLista.ListItems(I).SubItems(5)) > dataf.Value Then
lstLista.ListItems.Remove I
End If
Next
End Sub
' Carrega o cadastro selecionado'
Private Sub lstLista_DblClick()
Dim linha, Index
Dim I As Integer
Dim oList As Object
Dim indiceRegistro As Long
Set oList = lstLista.SelectedItem
If oList Is Nothing Then
Exit Sub
Else
indiceRegistro = cmsCadastro.ProcuraIndiceRegistroPodId(lstLista.ListItems.Item(lstLista.SelectedItem.Index))
If indiceRegistro <> -1 Then
Call cmsCadastro.CarregaRegistroPorIndice(indiceRegistro)
End If
Unload Me
End If
cmsCadastro.Show
End Sub
