none
NumLock desativando sozinho RRS feed

  • Pergunta

  • 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




    quinta-feira, 16 de abril de 2015 12:43

Respostas

  • O NumLock está desativando porque esse é um dos efeitos do SendKeys. Troque a rotina abaixo:

            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

    por, por exemplo:

    Private Sub dataf_Change()
        'Formata : dd/mm/aaaa'
        If Len(dataf) = 2 Or Len(dataf) = 5 Then
            dataf.Text = dataf.Text & "/"
            dataf.SelStart = Len(dataf)
        End If
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta Carlos H V Brito quinta-feira, 16 de abril de 2015 14:44
    quinta-feira, 16 de abril de 2015 13:01
    Moderador

Todas as Respostas

  • Tente isso:

    Public Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long
    
    Function AltEstadoTecla(Tecla, mAtiva As Boolean)
    Dim ws As Object
    Set ws = CreateObject("WScript.shell")
    
    If mAtiva Then
       If GetKeyState(Tecla) = 0 Then ws.SendKeys "{numlock}"
    Else
       If GetKeyState(Tecla) = 1 Then ws.SendKeys "{numlock}"
    End If
    Set ws = Nothing
    
    End Function
    

    Para chamar use:

    altestadoTecla 144, true

    Fonte:

    http://comunidade.itlab.com.br/eve/forums/a/tpc/f/273606921/m/2257015873


    Natan

    quinta-feira, 16 de abril de 2015 12:53
  • O NumLock está desativando porque esse é um dos efeitos do SendKeys. Troque a rotina abaixo:

            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

    por, por exemplo:

    Private Sub dataf_Change()
        'Formata : dd/mm/aaaa'
        If Len(dataf) = 2 Or Len(dataf) = 5 Then
            dataf.Text = dataf.Text & "/"
            dataf.SelStart = Len(dataf)
        End If
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta Carlos H V Brito quinta-feira, 16 de abril de 2015 14:44
    quinta-feira, 16 de abril de 2015 13:01
    Moderador
  • Pessoal, muito obrigado pelas respostas, eu acabei utilizando a sulução do Felipe e funcionou perfeitamente.
    quinta-feira, 16 de abril de 2015 14:45
  • não entendi, mas funcionou!!

    quarta-feira, 7 de setembro de 2016 02:17
  • Prezado Felipe, 

    No caso de campo de texto tipo caixa de texto ou listagem que serve de pesquisa. Como faço para mandar um comasdo para continuar alterando o campo sem usar o sendKeys "F2". 

    Private Sub txtrazaosocial_Change()
       If VarEspaco = 1 Then
          VarEspaco = 0
       Else
            Me.Recalc
            Me.txtrazaosocial.SetFocus
            SendKeys "{F2}"
            End If
    End Sub
    

    terça-feira, 7 de março de 2017 18:19
  • o que você pode fazer é trocar o 

    SendKeys "{f2}"


    por esse comando

    Dim ws As Object
    Set ws = CreateObject("WScript.shell")
    ws.SendKeys "{f2}"

    ai ficaria assim

    Private Sub txtrazaosocial_Change()
       If VarEspaco = 1 Then
          VarEspaco = 0
       Else
            Me.Recalc
            Me.txtrazaosocial.SetFocus
            Dim ws As Object
    	Set ws = CreateObject("WScript.shell")
    	ws.SendKeys "{f2}"
            End If
    End Sub

    estava com o mesmo problema e achei um forum aonde tinha essa solução, que funcionou muito bem.


    segunda-feira, 23 de julho de 2018 14:54
  • O NumLock está desativando porque esse é um dos efeitos do SendKeys. Troque a rotina abaixo:

            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

    por, por exemplo:

    Private Sub dataf_Change()
        'Formata : dd/mm/aaaa'
        If Len(dataf) = 2 Or Len(dataf) = 5 Then
            dataf.Text = dataf.Text & "/"
            dataf.SelStart = Len(dataf)
        End If
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    MUITO "BOM"...FUNCIONOU PERFEITAMENTE.... Muito Obrigado e "PARABENS" !!!
    quarta-feira, 26 de janeiro de 2022 20:56