Ir ao conteúdo
  • Cadastre-se

Adriano Delvali

Membro Pleno
  • Total de itens

    24
  • Registro em

  • Última visita

  • Qualificações

    0%

Posts postados por Adriano Delvali

  1. @Basole Estava ausente, por isso não consegui responder na terça.

     

    Olha, ficou perfeita a busca no banco, era exatamente isso. só acertei o range, pois no laudo somente 1 célula ira aceitar o dado buscado ("B3"). mas ficou show.

     

    Em relação a 2ª dúvida: para cada item que eu busco existe um fornecedor. porém nesse caso não tenho os códigos deles, por isso preciso buscar em um listbox pelo nome.

     

    a ideia era clicar em uma determinada célula e abrir um listbox com todos os fornecedores e eu selecionar um deles e o resultado preencher uma célula (no exemplo seria a "D3"). você ja fez isso para mim, porém abrindo o listbox de um banco excel, o que preciso é modificar para o listbox vir do access.

     

    conseguiu entender?

     

     

     

     

     

     

     

     

  2. @Basole eu estou precisando fazer as duas rotinas que estou fazendo atualmente com o banco excel

     

    1ª - hoje eu digito o código de um determinado item em uma célula (B3) e na outra célula carrega a descrição (C3) (PROCV). Eu queria fazer isso na minha planilha sem utilizar um useform (digitar o código em uma célula, ele fazer um procv no banco access e carregar na outra célula a descrição.  

    2ª Adaptar o código que você me fez pra mim no inicio do tópico para a busca ser no banco access (atualmente ele faz no banco excel)

     

     

     

  3. @Basole Funcionou perfeitamente, só fiz um ajuste na ordem de busca da planilha conforme o código. Mas ficou Show.

     

    Obrigado novamente! 

     With rs
            While rs.EOF = False
                TextoCelula = rs.Fields(1) 'Coluna 1 - ordem da aba na planilha
                 If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then
                ListBox1.AddItem rs.Fields(1) 'Coluna 1 - ordem da aba na planilha          
                 End If
                  rs.MoveNext
            Wend
    	    End With

     

     

     

  4. @Basole,Primeiramente obrigado pela disposição em sempre ajudar! Sou grato por isso.

     

    você está correto, é um listbox. Sou muito leigo no assunto. consigo apenas fazer algumas coisas e adaptações para uso.

     

    Tentei utilizar o código que você passou, mas me retornou um erro. Pode ser que tenha feito algo errado.

     

    Não sei se expliquei minha necessidade corretamente, mas para você ver minha aplicação, anexei uma planilha com o código que uso.

     

    Hoje funciona bem, mas a ideia é como falei inicialmente, ter um arquivo no servidor com os dados que serão carregados quando o usuário clicar em determinada célula.

     

    Obrigado mais uma vez!

     

     

     

    EXEMPLO LISTBOX.xls

  5. Boa tarde pessoal do Clube! Preciso de uma pequena ajuda num comando aqui.

     

    tenho o código abaixo que faz referência/busca a uma sheet dentro do próprio arquivo.

     

    estou tentando fazer a busca em um outro arquivo que fica no servidor, porém não esta dando certo.

    alguém pode me ajudar?

     

    código atual (funcionando)

    Option Explicit
    Private TextoDigitado As String
    Private Sub ListBox1_Click()
        ActiveCell.Value = ListBox1.Value
        Unload Me
    End Sub
    
    Private Sub UserForm_Initialize()
        Call PreencheLista
    End Sub
    Private Sub PreencheLista()
        Dim ws As Worksheet
        Dim i As Integer
        Dim TextoCelula As String
        Set ws = ThisWorkbook.Worksheets(9)
        i = 1
        ListBox1.Clear
        With ws
            While .Cells(i, 8).Value <> Empty
                TextoCelula = .Cells(i, 8).Value
                If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then
                    ListBox1.AddItem .Cells(i, 8)
                    
                End If
                i = i + 1
                       Wend
            
        End With
       
        
    
    End Sub

     código que estou tentando ajustar:

     

    Option Explicit

    Private TextoDigitado As String


    Private Sub ListBox1_Click()
        ActiveCell.Value = ListBox1.Value
        Unload Me
    End Sub
    Private Sub TextBox1_Change()
        TextoDigitado = TextBox1.Text
        Call PreencheLista
    End Sub


    Private Sub UserForm_Initialize()
        Call PreencheLista
    End Sub


    Private Sub PreencheLista()

     

    Dim wb As Workbook: Set wb = ActiveWorkbook

    Dim ws As Worksheet

    Dim strTemplate As String: strTemplate = "Z:\BANCO_DADOS\DADOS.xls"

    Set ws = wb.Sheets.Add(Type:=strTemplate)(9)


        i = 1
        ListBox1.Clear
        With ws
            While .Cells(i, 2).Value <> Empty
                TextoCelula = .Cells(i, 2).Value
                If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then
                    ListBox1.AddItem .Cells(i, 2)
                End If
                i = i + 1
            Wend
        End With
    End Sub
     

     

     

     

     

    • Curtir 1
  6. @Basole, cara desculpa atrapalhar, mas preciso de uma ajuda, se possível.

     

    Utilizo o código abaixo  para buscar diversos dados em uma aba da mesma planilha. Como o arquivo está ficando muito pesado, eu criei outra plan com o nome banco_dados e gostaria que a busca fosse feita a partir desse banco e não mais da mesma planilha (laudo de análise). consegue me dar uma força?

     

    segue o código.

     

    obrigado mais uma vez.

    
    
    Sub PESQUISA_BANCO()
    
    Application.ScreenUpdating = False
    
    
    '  *** PESQUISA Macro Codigo ***
        Dim pega As String, cr As Integer, rng As Range, i As Long
    
        Sheets("LAUDO").Activate
       
        If ThisWorkbook.Sheets("LAUDO").Range("b24").Value <> "" Then
                    Exit Sub
        Else
    
            Range("a36").Activate
            ActiveCell.Activate
            pega = VBA.Trim(ActiveCell.Value)
            If pega = "" Then
                MsgBox "É necessário informar o número de análise!!!", vbExclamation, "PESQUISA"
                
                Exit Sub
            End If
            Sheets("banco_dados").Activate
            cr = 0
            Set rng = ActiveSheet.Range("a" & Rows.Count).End(xlUp)
            For i = 2 To rng.Row
                'aqui você não precisa informar o nome completo
                'mas corre o risco de ficar em duplicidade
                If VBA.Trim(ActiveSheet.Cells(i, 78).Value) = VBA.Trim(pega) Then
    
                    
                    Cells(i, 1).Copy
                    Range("laudo!I6").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 2).Copy
                    Range("laudo!F6").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 3).Copy
                    Range("laudo!B4").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 4).Copy
                    Range("laudo!c8").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 5).Copy
                    Range("laudo!D9").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 6).Copy
                    Range("laudo!I9").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 7).Copy
                    Range("laudo!D10").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 8).Copy
                    Range("laudo!H10").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 9).Copy
                    Range("laudo!F10").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 10).Copy
                    Range("laudo!D11").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    
                    'PARAMETROS
                    Cells(i, 11).Copy
                    Range("laudo!B14").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 12).Copy
                    Range("laudo!B15").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 13).Copy
                    Range("laudo!B16").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 14).Copy
                    Range("laudo!B17").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 15).Copy
                    Range("laudo!B18").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 16).Copy
                    Range("laudo!B19").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 17).Copy
                    Range("laudo!B20").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 18).Copy
                    Range("laudo!B21").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 19).Copy
                    Range("laudo!B22").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 20).Copy
                    Range("laudo!B23").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 21).Copy
                    Range("laudo!B24").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 22).Copy
                    Range("laudo!B25").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 23).Copy
                    Range("laudo!B26").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 24).Copy
                    Range("laudo!B27").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 25).Copy
                    Range("laudo!B28").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    'UNIDADE
                    Cells(i, 26).Copy
                    Range("laudo!E14").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 27).Copy
                    Range("laudo!E15").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 28).Copy
                    Range("laudo!E16").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 29).Copy
                    Range("laudo!E17").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 30).Copy
                    Range("laudo!E18").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 31).Copy
                    Range("laudo!E19").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 32).Copy
                    Range("laudo!E20").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 33).Copy
                    Range("laudo!E21").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 34).Copy
                    Range("laudo!E22").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 35).Copy
                    Range("laudo!E23").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 36).Copy
                    Range("laudo!E24").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 37).Copy
                    Range("laudo!E25").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 38).Copy
                    Range("laudo!E26").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 39).Copy
                    Range("laudo!E27").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 40).Copy
                    Range("laudo!E28").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    
                    'RESULTADO
                    Cells(i, 41).Copy
                    Range("laudo!F14").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 42).Copy
                    Range("laudo!F15").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 43).Copy
                    Range("laudo!F16").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 44).Copy
                    Range("laudo!F17").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 45).Copy
                    Range("laudo!F18").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 46).Copy
                    Range("laudo!F19").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 47).Copy
                    Range("laudo!F20").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 48).Copy
                    Range("laudo!F21").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 49).Copy
                    Range("laudo!F22").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 50).Copy
                    Range("laudo!F23").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 51).Copy
                    Range("laudo!F24").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 52).Copy
                    Range("laudo!F25").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 53).Copy
                    Range("laudo!F26").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 54).Copy
                    Range("laudo!F27").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 55).Copy
                    Range("laudo!F28").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    
                     'ESPECIFICADO
                    Cells(i, 56).Copy
                    Range("laudo!I14").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 57).Copy
                    Range("laudo!I15").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 58).Copy
                    Range("laudo!I16").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 59).Copy
                    Range("laudo!I17").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 60).Copy
                    Range("laudo!I18").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 61).Copy
                    Range("laudo!I19").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 62).Copy
                    Range("laudo!I20").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 63).Copy
                    Range("laudo!I21").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 64).Copy
                    Range("laudo!I22").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 65).Copy
                    Range("laudo!I23").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 66).Copy
                    Range("laudo!I24").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 67).Copy
                    Range("laudo!I25").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 68).Copy
                    Range("laudo!I26").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 69).Copy
                    Range("laudo!I27").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 70).Copy
                    Range("laudo!I28").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    
                    Cells(i, 71).Copy
                    Range("laudo!D30").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 72).Copy
                    Range("laudo!E30").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 73).Copy
                    Range("laudo!C31").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 74).Copy
                    Range("laudo!B32").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 75).Copy
                    Range("laudo!D33").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 76).Copy
                    Range("laudo!J34").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    Cells(i, 77).Copy
                    Range("laudo!D35").PasteSpecial (xlPasteValues)
                    Application.CutCopyMode = False
                    
                    
                    
                                    Sheets("LAUDO").Select
                                    cd1 = Range("e8").Value
                                    cd = Range("c8").Value
                    pergunta = MsgBox("Analise Encontrada!" & _
                                      Chr(13) & "É possível que haja outras análises com o mesmo número," & _
                                      Chr(13) & "quer continuar a busca?" & Chr(13) & _
                                      Chr(13) & "Código do Insumo encontrado: " & cd & _
                                      Chr(13) & "Descrição do Insumo encontrado: " & cd1, _
                                      vbYesNo, "PESQUISA")
                    If pergunta = vbNo Then
                        Sheets("LAUDO").Select
                        MsgBox "Fim da Pesquisa!", vbExclamation, "PESQUISA"
                       
                        Exit Sub
                    Else
                        'Atenção com esta linha para alteração
                        'o loop pode mudar de direção
                        Sheets("banco_dados").Activate
                    End If
                    cr = cr + 1
                End If
            Next i
            If cr = 0 Then
                Sheets("LAUDO").Select
                MsgBox "Análise não encontrada!", vbExclamation, "PESQUISA"
            Else
                Sheets("LAUDO").Select
                MsgBox "Fim da busca, nº de análise encontradas: (" & cr & ")", vbExclamation, ""
            End If
        End If
       
        
        Application.ScreenUpdating = True
        
    End Sub
    

     

  7. Em 03/09/2016 às 10:37, Basole disse:

     

    @Basole, atualmente eu só consigo pesquisar digitando uma palavra chave ou o nome completo do produto. mas minha lista com o passar do tempo está muito grande, acima de 1500 itens, por isso eu queria ao invés de digitar palavra chave, digitar somente o código do produto, uma vez que todo produto tem um código único. compreende?

     

    o código antigo só aceitava texto. eu queria que aceitasse e buscasse pelo código que é composto de números.

     

    grato pela ajuda mais uma vez.

     

    att,

  8. Bom dia @Basole obrigado pela ajuda, mas agora esta aparecendo um erro que não sei como resolver.

     

    segue:

     

    a variável do objeto ou a variável do bloco with não foi definida

     

    rng = ActiveSheet.Range("b" & Rows.Count).End(xlUp).Row

     

     

    para facilitar, anexei a planilha. eu enxuguei ela bastante para não ficar pesado. retirei outras macros que não vem ao caso. 

     

    obrigado pela ajuda!

    Laudo de Análise - Garantia da Qualidade 2.xls

  9. Boa tarde,

     

    Uma pequena ajuda, sou meio leigo e encontrei um problema em uma macro de uma planilha que tenho.

     

    Eu preciso buscar por código(números) um certo produto em uma aba (insumos) de minha planilha. porém a macro que possuo só aceita texto. quando tento digitar um  número me retorna os códigos abaixo em amarelo:

     

    If Cells(i, 3).Text Like "*" + pega + "*" Then

     

    agora se digitar uma palavra chave ou o nome do produto eu tenho o retorno correto. podem me ajudar?

     

    abaixo a macro completa:

     

    Sub PESQUISA()
    '
    ' PESQUISA Macro
    
    
    Application.Sheets("CADASTRO").Select
    Range("D23").Select
    ActiveCell.Activate
    pega = ActiveCell.Value
    If pega = "" Then
    MsgBox "INFORME UMA PALAVRA CHAVE!!!", , "PESQUISA"
    Exit Sub
    End If
    Sheets("insumos").Select
    cr = 0
    Rng = Range("B" & Rows.Count).End(xlUp).Row
    For i = 3 To Rng Step 1
    'aqui você não precisa informar o nome completo
    'mas corre o risco de ficar em duplicidade
    If Cells(i, 3).Text Like "*" + pega + "*" Then
    Cells(i, 3).Copy
    Range("CADASTRO!D23").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    Cells(i, 2).Copy
    Range("CADASTRO!D24").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    Cells(i, 1).Copy
    Range("CADASTRO!D25").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    Sheets("CADASTRO").Select
    cd = Range("D24").Value
    pergunta = MsgBox("Insumo Encontrado!" & _
    Chr(13) & "É possível que haja outros INSUMOS com a mesma palavra chave," & _
    Chr(13) & "quer continuar a busca por outros insumos?" & Chr(13) & _
    "Código do Insumo: " & cd, _
    vbYesNo, "PESQUISA")
    If pergunta = vbNo Then
    Sheets("CADASTRO").Select
    MsgBox "Fim da Pesquisa!", , "PESQUISA"
    Exit Sub
    Else
    'Atenção com esta linha para alteração
    'o loop pode mudar de direção
    Sheets("insumos").Select
    End If
    cr = cr + 1
    End If
    Next i
    If cr = 0 Then
    Sheets("CADASTRO").Select
    MsgBox "Insumo não Cadastrado!", , "PESQUISA"
    Else
    Sheets("CADASTRO").Select
    MsgBox "Fim da busca, nº de insumos encontrados: (" & cr & ")", , ""
    End If
    End Sub

     

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

Aprenda a ler resistores e capacitores

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!