Notifications
Clear all

Textbox para datas, moeda, horas.

3 Posts
3 Usuários
0 Reactions
1,056 Visualizações
(@sangiorgio)
Posts: 0
New Member
Topic starter
 

Copiei e adaptei o seguinte código da internet à minha planilha:

O problema é que o textbox 2 trata-se de horas, na planilha onde é lançado, os dados são salvos como hora, porém quando pesquiso ele aparece como número decimal 0,56568454.

Outro problema é que o textbox 3 trata-se de data, na planilha onde é lançado, os dados são salvos no mesmo formato de data que lançei. O problema é que fiz também uma pesquisa com uma fórmula, em outra aba, para pesquisar a partir da data e a pesquisa só reconhece a data quando entro na aba onde os dados estão salvos e clico na data e dou enter, sem acrescentar nada.

Public MatrizResultadosLinha As Variant
Public MatrizResultadosPlanilha As Variant
Public Total_Ocorrencias As Long
Public sCriterioDaBusca As String
Public sAcaoRequerida As String


Private Sub btn_Adicionar_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 btn_Adicionar_Click()
    
    'Definir a ação do comando
    sAcaoRequerida = "Adicionar"
    
    'Habilitar Botões Salvar/Cancelar
    Call HabilitarControlesParaEdicao(True)
    
    
End Sub

Private Sub btn_Cancelar_Click()
    
    'Definir a ação do comando
    sAcaoRequerida = ""
    
    'Habilitar Botões Salvar/Cancelar
    Call HabilitarControlesParaEdicao(False)
    
    'Recarrega os controles com os valores ativos na memória
    Call SpinButton1_Change
    
    txt_Procurar.Text = sCriterioDaBusca
    
End Sub

Private Sub btn_Editar_Click()
    
    'Definir a ação do comando
    sAcaoRequerida = "Editar"
    
    'Habilitar Botões Salvar/Cancelar
    Call HabilitarControlesParaEdicao(True)
    
End Sub

Private Sub btn_Excluir_Click()
Dim sLinha As Long
Dim iPlanilha As Integer

    If MsgBox("Tem certeza que deseja eliminar este cadastro do sistema?", vbDefaultButton2 + vbQuestion + vbYesNo, Me.Caption) = vbYes Then
        sLinha = MatrizResultadosLinha(SpinButton1.Value)
        iPlanilha = MatrizResultadosPlanilha(SpinButton1.Value)
        
        'Exclui a linha do registro
        Sheets(iPlanilha).Rows(sLinha).Delete
        
        'Salva o arquivo
        ThisWorkbook.Save
        
        'Recarrega os registros para o formulário
        txt_Procurar.Text = sCriterioDaBusca
        Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
    End If
    
End Sub

Private Sub btn_Procurar_Click()

    If txt_Procurar.Text = "" Then
        MsgBox "Digite um valor para a pesquisa"
    Else
        sCriterioDaBusca = txt_Procurar.Text
        Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
    End If
    
End Sub

Private Sub btn_Salvar_Click()
Dim sLinha As Long
Dim iPlanilha As Integer

    'Realiza a ação apropriada
    Select Case sAcaoRequerida
        Case "Adicionar"
            With Sheets(Combo_OndeSalvar.Text)
                sLinha = .Range("A1").SpecialCells(xlLastCell).Row + 1  'Pega a próxima linha vazia para cadastrar novo
                'Grava os novos valores informados no formulário para a planilha base de dados
                .Cells(sLinha, 1).Value = TextBox1.Text
                .Cells(sLinha, 2).Value = TextBox2.Text
                .Cells(sLinha, 3).Value = TextBox3.Text
                .Cells(sLinha, 4).Value = TextBox4.Text
                .Cells(sLinha, 5).Value = TextBox5.Text
                .Cells(sLinha, 6).Value = TextBox6.Text
                .Cells(sLinha, 7).Value = TextBox7.Text
                .Cells(sLinha, 8).Value = TextBox8.Text
                .Cells(sLinha, 9).Value = TextBox9.Text
           End With
        Case "Editar"
            sLinha = MatrizResultadosLinha(SpinButton1.Value)
            iPlanilha = MatrizResultadosPlanilha(SpinButton1.Value)
            
            With Sheets(iPlanilha)
                'Atualiza os dados na linha de registro específica
                .Cells(sLinha, 1).Value = TextBox1.Text
                .Cells(sLinha, 2).Value = TextBox2.Text
                .Cells(sLinha, 3).Value = TextBox3.Text
                .Cells(sLinha, 4).Value = TextBox4.Text
                .Cells(sLinha, 5).Value = TextBox5.Text
                .Cells(sLinha, 6).Value = TextBox6.Text
                .Cells(sLinha, 7).Value = TextBox7.Text
                .Cells(sLinha, 8).Value = TextBox8.Text
                .Cells(sLinha, 9).Value = TextBox9.Text
           End With
        Case Else
            Exit Sub
    End Select
    
    'Definir a ação do comando
    sAcaoRequerida = ""
    
    'Habilitar Botões Salvar/Cancelar
    Call HabilitarControlesParaEdicao(False)
    
    'Recarrega os valores da pesquisa para exibir no formulário
    If sCriterioDaBusca <> "" Then
        txt_Procurar.Text = sCriterioDaBusca
        Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
    End If
    
    'Salva o arquivo
    ThisWorkbook.Save
    
End Sub

Private Sub ComboBox1_Change()

End Sub

Private Sub Label1_Click()

End Sub

Private Sub Label9_Click()

End Sub

Private Sub SpinButton1_Change()
Dim sLinha As Long
Dim iPlanilha As Integer
Dim TotalOcorrencias As Long

    If IsArray(MatrizResultadosLinha) Then  'Verifica se há informações de busca na matriz de resultados
                                            'Se houver dados retornados da busca, então carrega no formulário
        TotalOcorrencias = SpinButton1.Max + 1
        sLinha = MatrizResultadosLinha(SpinButton1.Value)
        iPlanilha = MatrizResultadosPlanilha(SpinButton1.Value)
        
        Label_Registros_Contador.Caption = SpinButton1.Value + 1 & " de " & TotalOcorrencias
        
        With Sheets(iPlanilha)
            Label_PlanBase.Caption = "Em " & .Name
            TextBox1.Text = .Cells(sLinha, 1).Value
            TextBox2.Text = .Cells(sLinha, 2).Value
            TextBox3.Text = .Cells(sLinha, 3).Value
            TextBox4.Text = .Cells(sLinha, 4).Value
            TextBox5.Text = .Cells(sLinha, 5).Value
            TextBox6.Text = .Cells(sLinha, 6).Value
            TextBox7.Text = .Cells(sLinha, 7).Value
            TextBox8.Text = .Cells(sLinha, 8).Value
            TextBox9.Text = .Cells(sLinha, 9).Value
        End With
    End If
    
End Sub


Private Sub ProcuraPersonalizada(ByVal TermoPesquisado As String, ByVal sPesquisarNoCampo As String)
Dim Busca As Range
Dim Primeira_Ocorrencia As String
Dim ResultadosLinha As String
Dim ResultadosPlanilha As String
Dim sSearchInCol As String
Dim arrPesquisarNasPlanilhas As Variant
Dim i As Integer

    'Define a Coluna onde a informação será pesquisada
    sSearchInCol = ConfigColunas(sPesquisarNoCampo)
    
    'Define as Planilhas onde a informação será pesquisada
    arrPesquisarNasPlanilhas = ConfigPlanilhasBase
    
    'Inicializa os resultados
    ResultadosLinha = ""
    ResultadosPlanilha = ""
    MatrizResultadosLinha = ""
    MatrizResultadosPlanilha = ""
                
    'Executa a busca
    
    For i = 0 To UBound(arrPesquisarNasPlanilhas)
        With Sheets(arrPesquisarNasPlanilhas(i))
            If sSearchInCol = "" Then
                Set Busca = .Cells.Find(What:=TermoPesquisado, After:=.Range("A1"), LookIn:=xlFormulas, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)
            Else
                Set Busca = .Range(sSearchInCol & ":" & sSearchInCol).Find( _
                    What:=TermoPesquisado, _
                    After:=.Range(sSearchInCol & "1"), _
                    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)
            End If
            
            'Caso tenha encontrado alguma ocorrência...
            If Not Busca Is Nothing Then
            
                Primeira_Ocorrencia = Busca.Address
                ResultadosLinha = ResultadosLinha & IIf((Len(ResultadosLinha) > 0), ";", "") & Busca.Row 'Lista o primeiro resultado na variavel - linha da ocorrência
                ResultadosPlanilha = ResultadosPlanilha & IIf((Len(ResultadosPlanilha) > 0), ";", "") & .Index 'Lista o primeiro resultado na variavel - planilha da ocorrência
            
                'Neste loop, pesquisa todas as próximas ocorrências para
                'o termo pesquisado
                Do
                    If sSearchInCol = "" Then
                        Set Busca = .Cells.FindNext(After:=Busca)
                    Else
                        Set Busca = .Range(sSearchInCol & ":" & sSearchInCol).FindNext(After:=Busca)
                    End If
                
                    'Condicional para não listar o primeiro resultado
                    'pois já foi listado acima
                    If Not Busca.Address Like Primeira_Ocorrencia Then
                        ResultadosLinha = ResultadosLinha & ";" & Busca.Row
                        ResultadosPlanilha = ResultadosPlanilha & ";" & .Index
                    End If
                Loop Until Busca.Address Like Primeira_Ocorrencia
            
            End If
        End With
    Next i
    
    
    If Len(ResultadosLinha) > 0 Then    'Se foram encontrados resultados
        MatrizResultadosLinha = Split(ResultadosLinha, ";")
        MatrizResultadosPlanilha = Split(ResultadosPlanilha, ";")
        
        'Atualiza dados iniciais no formulário
        SpinButton1.Max = UBound(MatrizResultadosLinha)  'Valor maximo do seletor de registros
        
        'habilita o seletor de registro
        SpinButton1.Enabled = True
        
        'indicador do seletor de registros
        Label_Registros_Contador.Caption = "1 de " & UBound(MatrizResultadosLinha) + 1
        
        
        'Box com o conteudo encontrado
        With Sheets(CInt(MatrizResultadosPlanilha(0)))
            Label_PlanBase.Caption = "Em " & .Name
            TextBox1.Text = .Cells(MatrizResultadosLinha(0), 1).Value
            TextBox2.Text = .Cells(MatrizResultadosLinha(0), 2).Value
            TextBox3.Text = .Cells(MatrizResultadosLinha(0), 3).Value
            TextBox4.Text = .Cells(MatrizResultadosLinha(0), 4).Value
            TextBox5.Text = .Cells(MatrizResultadosLinha(0), 5).Value
            TextBox6.Text = .Cells(MatrizResultadosLinha(0), 6).Value
            TextBox7.Text = .Cells(MatrizResultadosLinha(0), 7).Value
            TextBox8.Text = .Cells(MatrizResultadosLinha(0), 8).Value
            TextBox9.Text = .Cells(MatrizResultadosLinha(0), 9).Value
            
        End With
        
        btn_Editar.Enabled = True
        btn_Excluir.Enabled = True
    
    Else    'Caso nada tenha sido encontrado, exibe mensagem informativa
    
        SpinButton1.Enabled = False     'desabilita o seletor de registros
        btn_Editar.Enabled = False
        btn_Excluir.Enabled = False
        Label_Registros_Contador.Caption = ""   'zera os resultados encontrados
        Label_PlanBase.Caption = ""
        'limpa os campos do formulário
        TextBox1.Text = ""
        TextBox2.Text = ""
        TextBox3.Text = ""
        TextBox4.Text = ""
        TextBox5.Text = ""
        TextBox6.Text = ""
        TextBox7.Text = ""
        TextBox8.Text = ""
        TextBox9.Text = ""
        MsgBox "Nenhum resultado para '" & TermoPesquisado & "' foi encontrado."
    
    End If
    
End Sub

Private Sub TextBox3_Change()

End Sub

Private Sub TextBox7_Change()

End Sub

Private Sub txt_Procurar_Change()

End Sub

Private Sub UserForm_Initialize()

    SpinButton1.Enabled = False
    btn_Editar.Enabled = False
    btn_Excluir.Enabled = False
    Combo_OndeSalvar.Visible = False
    Label_OndeSalvar.Visible = False
    Label_Registros_Contador.Caption = ""
    Call ConfigurarListaDeCampos
    
End Sub

Sub ConfigurarListaDeCampos()
Dim arrPesquisarNasPlanilhas As Variant
Dim i As Integer
    
    With ComboBox1
        .Style = fmStyleDropDownList
        
        .AddItem "Tudo"     '<--- Esta é utilizada para definir quando pesquisar em toda a planilha
        .AddItem "Nome"
        .AddItem "Setor"
        .AddItem "Tipo de atendimento"
        .AddItem "Atendente"
        
        .ListIndex = 0
    End With
    
    With Combo_OndeSalvar
        'Recupera as Planilhas que são base de dados
        arrPesquisarNasPlanilhas = ConfigPlanilhasBase
    
        .Style = fmStyleDropDownList
        
        For i = 0 To UBound(arrPesquisarNasPlanilhas)
            .AddItem arrPesquisarNasPlanilhas(i)
        Next i
        
        .ListIndex = 0
    End With
    
    

End Sub

Function ConfigColunas(ByVal sNomeCampo As String) As String

    Select Case sNomeCampo
        Case "Nome"
            ConfigColunas = "A"
        Case "Setor"
            ConfigColunas = "F"
        Case "Data"
            ConfigColunas = "G"
        Case "Documento"
            ConfigColunas = "H"
        Case Else           '<--- Esta é utilizada para definir quando pesquisar em toda a planilha
            ConfigColunas = ""
    End Select
    
End Function

Function ConfigPlanilhasBase() As Variant
Dim sNomeDasPlanilhas As String

    'Digite o nome das Planilhasonde os dados deverão ser procurados,
    'separados por ponto-e-vírgula (;)
    '
    sNomeDasPlanilhas = "Plan1;PlanBase2"   '<----- Informe as planilhas aqui
    
    
    Do While (Right(sNomeDasPlanilhas, 1) = ";")
        sNomeDasPlanilhas = Left(sNomeDasPlanilhas, Len(sNomeDasPlanilhas) - 1)
    Loop
    
    ConfigPlanilhasBase = Split(sNomeDasPlanilhas, ";")
    
End Function

Sub HabilitarControlesParaEdicao(ByVal bOpcao As Boolean)
    
    'Habilitar Botões Salvar/Cancelar
    btn_Salvar.Visible = bOpcao
    btn_Cancelar.Visible = bOpcao
    btn_Adicionar.Visible = Not (bOpcao)
    btn_Editar.Visible = Not (bOpcao)
    btn_Excluir.Visible = Not (bOpcao)
    
    btn_Procurar.Enabled = Not (bOpcao)
    txt_Procurar.Enabled = Not (bOpcao)
    ComboBox1.Enabled = Not (bOpcao)
    txt_Procurar.Value = ""
    Label_Registros_Contador.Caption = ""
    Label_PlanBase.Caption = ""
    
    If bOpcao = False And IsArray(MatrizResultadosLinha) Then
        SpinButton1.Enabled = True
    Else
        SpinButton1.Enabled = False
    End If
    
    'Liberar Campos para Edição.
    TextBox1.Locked = Not (bOpcao)
    TextBox2.Locked = Not (bOpcao)
    TextBox3.Locked = Not (bOpcao)
    TextBox4.Locked = Not (bOpcao)
    TextBox5.Locked = Not (bOpcao)
    TextBox6.Locked = Not (bOpcao)
    TextBox7.Locked = Not (bOpcao)
    TextBox8.Locked = Not (bOpcao)
    TextBox9.Locked = Not (bOpcao)
    
    'Limpar o conteúdo dos campos
    If sAcaoRequerida <> "Editar" Then
        TextBox1.Value = ""
        TextBox2.Value = ""
        TextBox3.Value = ""
        TextBox4.Value = ""
        TextBox5.Value = ""
        TextBox6.Value = ""
        TextBox7.Value = ""
        TextBox8.Value = ""
        TextBox9.Value = ""
        
        Combo_OndeSalvar.Visible = bOpcao
        Label_OndeSalvar.Visible = bOpcao
    End If
    
    If bOpcao = True Then
        TextBox1.SetFocus
    End If
    

End Sub
 
Postado : 17/10/2017 11:16 am
(@wagner-morel-vidal-nobre)
Posts: 4063
Famed Member
 

Sangiorgio,

Boa tarde!

Anexe seu arquivo aqui mesmo no fórum, compactado com .ZIP, para que possamos rodar, entender, depurar e ajudar. Aproveite e explique melhor e com maior riqueza de detalhes pois, pelo menos, para mim, sua necessidade não ficou clara.

 
Postado : 17/10/2017 12:06 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Analisar esta rotina por inteiro sem ter o modelo como o colega Wagner solicitou é meio inviável, mas pelo que está dizendo, eu entendo como falta de conversão dos tipos corretamente e ou formatação dos valores corretamente, uma vez que os TextBox por padrão são do tipo texto.
Quanto a questão da pesquisa ter de estar na aba, voce tem uma Function ConfigPlanilhasBase onde temos duas no Array, onde separamos atraves do Split, mas não temos instrução Set definindo como Worksheet e nem um Sheet Select ou Activate.

Pesquise por Formatação de TextBox e Definição de Tipos e a instrução Set no forum e encontrara vários tópicos a respeito.

[]s

 
Postado : 17/10/2017 12:31 pm