none
COMO INFORMAR EM UMA CAIXA DE TEXTO O RESULTADO DE OUTROS FILTROS DE UM FORMULARIO RRS feed

  • Pergunta

  • PESSOAL COMO FAÇO PRA LANÇAR O PREÇO NA CAIXA DE TEXTO DO FORMULARIO? ALGUEM PODE ME AJUDAR?

    http://uploaded.to/file/cxtiqy7h

    LINK DAS FOTOS

    SEGUE O MEU CODIGO ABAIXO

    Private Sub cmdMenu_Click()
        Unload frmTabela
        frmMenu.Show
    End Sub
    
    Private Sub txtCodigo_Change()
    
    End Sub
    
    Private Sub UserForm_Initialize()
    Dim SomaAno As Long
    Dim A As Integer: Dim ArrAnoVal As Variant: Dim ListaAnoValor As String
    'ATENÇÃO! se a coluna de sua planilha conter mais de 100 elementos aumente o valor d variavel "ArrAno"
    ReDim ArrAno(1000)
        Sheets("Tabela").Activate
        Sheets("Tabela").Select
        
        vAno = 0
        SomaAno = vAno + 2
    
        Do While ActiveSheet.Range("A" & Trim(SomaAno)) <> Empty
            ArrAno(vAno) = ActiveSheet.Range("A" & Trim(SomaAno))
            vAno = vAno + 1
            SomaAno = vAno + 1
        Loop
              
        For A = LBound(ArrAno) To UBound(ArrAno) - 1
            If A = 0 Then
                ListaAnoValor = ArrAno(A)
                
                Else
                If InStr(1, ListaAnoValor, ArrAno(A)) = 0 Then ListaAnoValor = ListaAnoValor & ";" & ArrAno(A)
            End If
        Next A
        
        ArrAnoVal = Split(ListaAnoValor, ";")
        ReDim ArrAno(UBound(ArrAnoVal))
        
        frmTabela.cbAno.Clear
        For A = LBound(ArrAnoVal) To UBound(ArrAnoVal)
            frmTabela.cbAno.AddItem ArrAnoVal(A)
        Next
    End Sub
    
    Private Sub cbano_Change()
    Dim SomaModelo As Long
    Dim M As Integer: Dim ArrModVal As Variant: Dim ListaModValor As String
    'ATENÇÃO! se a coluna de sua planilha conter mais de 100 elementos aumente o valor d variavel "ArrModelo"
    ReDim ArrModelo(1000)
    
        vMod = 0
        SomaModelo = vMod + 2
        
        If frmTabela.cbAno.Text <> Empty Then
            Do While ActiveSheet.Range("A" & Trim(SomaModelo)) <> Empty
                If ActiveSheet.Range("A" & Trim(SomaModelo)) = frmTabela.cbAno.Text And _
                    ActiveSheet.Range("B" & Trim(SomaModelo)) <> Empty Then
                    ArrModelo(vMod) = ActiveSheet.Range("B" & Trim(SomaModelo))
                        
                    vMod = vMod + 1
                    SomaModelo = SomaModelo + 1
                        
                    Else
                    SomaModelo = SomaModelo + 1
                End If
            Loop
        End If
        
        For M = LBound(ArrModelo) To UBound(ArrModelo) - 1
            If M = 0 Then
                ListaModValor = ArrModelo(M)
                
                Else
                If InStr(1, ListaModValor, ArrModelo(M)) = 0 Then ListaModValor = ListaModValor & ";" & ArrModelo(M)
            End If
        Next M
        
        ArrModVal = Split(ListaModValor, ";")
        ReDim ArrModelo(UBound(ArrModVal))
        
        frmTabela.cbModelo.Clear
        For M = LBound(ArrModVal) To UBound(ArrModVal)
            frmTabela.cbModelo.AddItem ArrModVal(M)
        Next
    End Sub
    
    Private Sub cbmodelo_Change()
    Dim SomaDescricao As Long
    Dim D As Integer: Dim ArrDescVal As Variant: Dim ListaDescValor As String
    'ATENÇÃO! se a coluna de sua planilha conter mais de 100 elementos aumente o valor d variavel "ArrDescricao"
    ReDim ArrDescricao(1000)
       
        vDesc = 0
        SomaDescricao = vDesc + 2
        
        If frmTabela.cbModelo.Text <> Empty Then
            Do While ActiveSheet.Range("A" & Trim(SomaDescricao)) <> Empty
                If ActiveSheet.Range("A" & Trim(SomaDescricao)) = frmTabela.cbAno.Text And _
                    ActiveSheet.Range("B" & Trim(SomaDescricao)) = frmTabela.cbModelo.Text And _
                    ActiveSheet.Range("C" & Trim(SomaDescricao)) <> Empty Then
                    ArrDescricao(vDesc) = ActiveSheet.Range("C" & Trim(SomaDescricao))
                        
                    vDesc = vDesc + 1
                    SomaDescricao = SomaDescricao + 1
                        
                    Else
                    SomaDescricao = SomaDescricao + 1
                End If
            Loop
        End If
                        
        For D = LBound(ArrDescricao) To UBound(ArrDescricao) - 1
            If D = 0 Then
                ListaDescValor = ArrDescricao(D)
                
                Else
                If InStr(1, ListaDescValor, ArrDescricao(D)) = 0 Then ListaDescValor = ListaDescValor & ";" & ArrDescricao(D)
            End If
        Next D
        ArrDescVal = Split(ListaDescValor, ";")
        ReDim ArrDescricao(UBound(ArrDescVal))
        
        frmTabela.cbDescricao.Clear
        For D = LBound(ArrDescVal) To UBound(ArrDescVal)
            frmTabela.cbDescricao.AddItem ArrDescVal(D)
        Next
    End Sub
    
    Private Sub cbdescricao_Change()
    Dim SomaCor As Long
    Dim C As Integer: Dim ArrCorVal As Variant: Dim ListaCorValor As String
    'ATENÇÃO! se a coluna de sua planilha conter mais de 100 elementos aumente o valor d variavel "ArrCor"
    ReDim ArrCor(1000)
            
        vCor = 0
        SomaCor = vCor + 2
        
        If frmTabela.cbDescricao.Text <> Empty Then
            Do While ActiveSheet.Range("A" & Trim(SomaCor)) <> Empty
                If ActiveSheet.Range("A" & Trim(SomaCor)) = frmTabela.cbAno.Text And _
                    ActiveSheet.Range("B" & Trim(SomaCor)) = frmTabela.cbModelo.Text And _
                    ActiveSheet.Range("C" & Trim(SomaCor)) = frmTabela.cbDescricao.Text And _
                    ActiveSheet.Range("D" & Trim(SomaCor)) <> Empty Then
                    ArrCor(vCor) = ActiveSheet.Range("D" & Trim(SomaCor))
                    
                    vCor = vCor + 1
                    SomaCor = SomaCor + 1
                        
                    Else
                    SomaCor = SomaCor + 1
                End If
            Loop
        End If
        
        For C = LBound(ArrCor) To UBound(ArrCor) - 1
            If C = 0 Then
                ListaCorValor = ArrCor(C)
                
                Else
                If InStr(1, ListaCorValor, ArrCor(C)) = 0 Then ListaCorValor = ListaCorValor & ";" & ArrCor(C)
            End If
        Next C
        
        ArrCorVal = Split(ListaCorValor, ";")
        ReDim ArrCor(UBound(ArrCorVal))
        
        frmTabela.cbCor.Clear
        For C = LBound(ArrCorVal) To UBound(ArrCorVal)
            frmTabela.cbCor.AddItem ArrCorVal(C)
        Next
    End Sub
    
    Private Sub cbcor_Change()
    Dim Linha As Long
    
        frmTabela.txtCodigo.Text = Empty
        
        Linha = 2
        If frmTabela.cbCor.Text <> Empty Then
            Do While ActiveSheet.Range("A" & Trim(Linha)) <> Empty
                If ActiveSheet.Range("A" & Trim(Linha)) = frmTabela.cbAno.Text And _
                    ActiveSheet.Range("B" & Trim(Linha)) = frmTabela.cbModelo.Text And _
                    ActiveSheet.Range("C" & Trim(Linha)) = frmTabela.cbDescricao.Text And _
                    ActiveSheet.Range("D" & Trim(Linha)) = cbCor.Text And _
                    ActiveSheet.Range("E" & Trim(Linha)) <> Empty Then
                    txtCodigo.Text = ActiveSheet.Range("E" & Trim(Linha))
                End If
                Linha = Linha + 1
            Loop
        Linha = o
        End If
    End Sub
    
    
    

    terça-feira, 5 de junho de 2012 02:59

Respostas

  • Pessoal fui testando os códigos e consegui acertar o local para fazer o que falei

    Private Sub cbcor_Change()
    Dim Linha As Long

        frmTabela.txtCodigo.Text = Empty
       
        Linha = 2
        If frmTabela.cbCor.Text <> Empty Then
            Do While ActiveSheet.Range("A" & Trim(Linha)) <> Empty
                If ActiveSheet.Range("A" & Trim(Linha)) = frmTabela.cbAno.Text And _
                    ActiveSheet.Range("B" & Trim(Linha)) = frmTabela.cbModelo.Text And _
                    ActiveSheet.Range("C" & Trim(Linha)) = frmTabela.cbDescricao.Text And _
                    ActiveSheet.Range("D" & Trim(Linha)) = cbCor.Text And _
                    ActiveSheet.Range("E" & Trim(Linha)) <> Empty Then
                    txtCodigo.Text = ActiveSheet.Range("E" & Trim(Linha))
                    txtPreço.Text = ActiveSheet.Range("F" & Trim(Linha))
                    txtTempo.Text = ActiveSheet.Range("G" & Trim(Linha))
                    txtCódigoServiço.Text = ActiveSheet.Range("H" & Trim(Linha))
                End If
                Linha = Linha + 1
            Loop
        Linha = o
        End If
    End Sub

    era so adicionar conforme o codigo acima. mas obrigado mais uma vez pela ajuda a todos

    quinta-feira, 7 de junho de 2012 17:52

Todas as Respostas

  • O valor de código é único para cada registro da sua base de dados?

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

    quarta-feira, 6 de junho de 2012 01:05
    Moderador
  • Felipe, em minha tabela o campo código é exclusivo para cada item, não existe duplicidade, vou explicar melhor:

    suponhamos que um item tem as seguintes informações:


    modelo     descrição                               cor                codigo          preço       serviço(TEMPO)
    FILTROS   FILTRO DO AR DO MOTOR      PRETO         281133K200   R$61,50     0,6


    Com o codigo acima, quando vou escolhendo as opções ate chegar na cor, quando clico na cor, o formulario lança pra mim o codigo "28113k200" em uma caixa de texto chamada código, o que estou querendo fazer é adicionar mais duas informações quando isso ocorrer, quero que ele informe nas outras caixas de texto o preço e na outra caixa de texto o tempo de serviço. Ou seja informar em 3 caixas de texto os resultados obtidos pelo ultimo filtro que foi "cor".

    onde os dados das caixas de texto se chamam:

    codigo - txtCodigo
    preço - txtPreço
    serviço - txtServiço

    http://uploaded.to/file/gvfo5ehg

    segue link do formulario

    • Editado gustavo live quinta-feira, 7 de junho de 2012 17:15 incluido o formulario
    quinta-feira, 7 de junho de 2012 17:10
  • Pessoal fui testando os códigos e consegui acertar o local para fazer o que falei

    Private Sub cbcor_Change()
    Dim Linha As Long

        frmTabela.txtCodigo.Text = Empty
       
        Linha = 2
        If frmTabela.cbCor.Text <> Empty Then
            Do While ActiveSheet.Range("A" & Trim(Linha)) <> Empty
                If ActiveSheet.Range("A" & Trim(Linha)) = frmTabela.cbAno.Text And _
                    ActiveSheet.Range("B" & Trim(Linha)) = frmTabela.cbModelo.Text And _
                    ActiveSheet.Range("C" & Trim(Linha)) = frmTabela.cbDescricao.Text And _
                    ActiveSheet.Range("D" & Trim(Linha)) = cbCor.Text And _
                    ActiveSheet.Range("E" & Trim(Linha)) <> Empty Then
                    txtCodigo.Text = ActiveSheet.Range("E" & Trim(Linha))
                    txtPreço.Text = ActiveSheet.Range("F" & Trim(Linha))
                    txtTempo.Text = ActiveSheet.Range("G" & Trim(Linha))
                    txtCódigoServiço.Text = ActiveSheet.Range("H" & Trim(Linha))
                End If
                Linha = Linha + 1
            Loop
        Linha = o
        End If
    End Sub

    era so adicionar conforme o codigo acima. mas obrigado mais uma vez pela ajuda a todos

    quinta-feira, 7 de junho de 2012 17:52