Formulário para Pesquisa e Inserção de Valores

Question

Bom dia Galera,

 

Necessito de uma ajuda com um forms do VBA... (Pra falar a verdade de toda ajuda kkkk)

Preciso criar um formulário onde necessito pesquisar e inserir dados após o retorno da pesquisa feita.

EX:

Pesquiso o número de uma nota fiscal na coluna B e insiro informações na mesma linha do retorno da pesquisa nas colunas F, H, I, J e K. Caso não exista essa nota fiscal, o forms deverá exibir uma mensagem informando a não existência da informação e limpar o formulário para a próxima pesquisa... 

 

Essa parte da mensagem eu já fiz... e os FORMS também, falta só o código de pesquisa e de inserção.

 

Desde já agradeço!!!

Answer 1

https://www.youtube.com/watch?v=VesNeMjWhhg

---

Anderson Diniz

Answer 2

https://www.youtube.com/watch?v=brtdfos3Wk0

---

Anderson Diniz

Answer 3

https://www.youtube.com/watch?v=IpitTJJKPzU

---

Anderson Diniz

Answer 4

https://www.youtube.com/watch?v=AtQOoI1qKx4

---

Anderson Diniz

Answer 5

https://www.youtube.com/watch?v=XB4P1k43thU

---

Anderson Diniz

Answer 6

https://www.youtube.com/watch?v=hDXb89qkKnc

---

Anderson Diniz

Answer 7

https://www.youtube.com/watch?v=Zy2fn0QZW0U

---

Anderson Diniz

Answer 8

https://www.youtube.com/watch?v=iyNPL3KzOS8

---

Anderson Diniz

Answer 9

https://www.youtube.com/watch?v=QYPiJY838y8

---

Anderson Diniz

Answer 10

Obrigado Anderson... mas aqui da empresa não consigo acessar o Youtube... :(  

Quando chegar em casa assisto os vídeos e tento reproduzir amanhã ;)

Answer 11

'=======================================================
'DECLARAÇÃO DE VARIÁVEIS
'=======================================================

Dim lin, linha As Long
Dim resposta As VbMsgBoxResult
Dim caminho As String




'=======================================================
'CADASTRAR ITEM
'=======================================================

Sub cadastrar()

'=======================================================
'VERIFICAR SE AS CAIXAS DE TEXTO FORAM PREENCHIDAS
'=======================================================

'PARA CADA CONTROLE DENTRO DO FORMULÁRIO
For Each Control In Me.Controls

    'SE O TIPO DE CONTROLE FOR "TextBox"
    If TypeName(Control) = "TextBox" Then
    
        'SE A CAIXA DE TEXTO ESTIVER VAZIA
        If Control.Text = Empty Then
        
            'MENSAGEM
            MsgBox "Preencha todos os campos."
            
            
            'SAIR DO EVENTO CLICK DO BOTÃO CADASTRAR
            Exit Sub
        
        End If
    
    End If

'PRÓXIMO CONTROLE
Next Control

'=======================================================
'VERIFICAR LINHA EM BRANCO NA PLANILHA
'=======================================================

lin = 40

While Not IsEmpty(Sheets(1).Cells(lin, 1))

lin = lin + 1

Wend

'=======================================================
'VERIFICAR SE O ITEM JÁ ESTÁ CADASTRADO
'=======================================================

linha = 40

While linha <= lin

    If txtISBN.Text = Sheets(1).Cells(linha, 1) Then
    
        MsgBox "ISBN já está cadastrado."
        
        Exit Sub
    
    End If

linha = linha + 1

Wend


'=======================================================
'PREENCHER CÉLULAS
'=======================================================

Sheets(1).Cells(lin, 1) = txtISBN.Text
Sheets(1).Cells(lin, 2) = UCase(txtTitulo.Text)
Sheets(1).Cells(lin, 3) = UCase(txtSecao.Text)
Sheets(1).Cells(lin, 4) = UCase(txtAutor.Text)
Sheets(1).Cells(lin, 5) = UCase(txtEditora.Text)
Sheets(1).Cells(lin, 6) = UCase(txtQuantidade.Text)


'=======================================================
'PREENCHER CAIXAS DE TEXTO
'=======================================================

txtISBN.Text = Sheets(1).Cells(lin, 1)
txtTitulo.Text = Sheets(1).Cells(lin, 2)
txtSecao.Text = Sheets(1).Cells(lin, 3)
txtAutor.Text = Sheets(1).Cells(lin, 4)
txtEditora.Text = Sheets(1).Cells(lin, 5)
txtQuantidade.Text = Sheets(1).Cells(lin, 6)


'=======================================================
'CARREGAR IMAGEM
'=======================================================

resposta = MsgBox("O item foi cadastrado com sucesso." _
& vbCrLf & "Deseja carregar uma imagem?", vbYesNo)

If resposta = vbYes Then
      
pegarCaminho:

    caminho = Application.GetOpenFilename()
    
    If Right(caminho, 4) = ".jpg" Or Right(caminho, 4) = ".bmp" Then
    
    On Error Resume Next
    Image1.Picture = LoadPicture(caminho)
    Image1.PictureSizeMode = fmPictureSizeModeStretch
    
    'C:\pasta\arquivo.jpg
     
    origem = caminho
    
    destino = "C:\Users\anderson\Desktop\demonstração do " & _
    "programa da biblioteca\IMAGENS\" & Sheets(1).Cells(lin, 1).Value & Right(caminho, 4)
    
    'C:\pasta\codigo.jpg
    
    FileCopy origem, destino
    
    Sheets(1).Cells(lin, 7) = destino
        
    Else

' O controle Image aceita arquivos nos seguintes formatos:

'.bmp, .cur, .gif, .ico, .jpg, .wmf
    
    MsgBox "Escolha uma imagem no formato .bmp ou . jpg", vbOKOnly, _
    "Formato de imagem inválido"
    
    resposta = MsgBox("Deseja carregar outra imagem?", vbYesNo)

If resposta = vbYes Then
    
    GoTo pegarCaminho
    
End If
    
    End If
     
    
End If


'=======================================================
'DESABILITAR CAIXAS DE TEXTO
'=======================================================

For Each Control In Me.Controls

    If TypeName(Control) = "TextBox" Then
    
        Control.Enabled = False
        
    End If
    
Next Control

'=======================================================
'HABILITAR BOTÃO NOVO CADASTRO
'=======================================================

cmdNovoCadastro.Enabled = True

'=======================================================
'DESABILITAR BOTÃO CADASTRAR
'=======================================================

cmdCadastrar.Enabled = False


'=======================================================
'SALVAR ARQUIVO
'=======================================================


ThisWorkbook.Save

End Sub

Private Sub cmdAlterarCadastroAcervo_Click()

Unload Me

AlterarCadastroAcervo.Show

End Sub

Private Sub cmdAlterarCadastroUsuario_Click()

Unload Me

AlterarCadastroUsuario.Show

End Sub

Private Sub cmdCadastrar_Click()

'=======================================================
'CADASTRAR ITEM
'=======================================================

cadastrar

End Sub

Private Sub cmdCadastrarUsuario_Click()

Unload Me

CadastrarUsuario.Show

End Sub

Private Sub cmdConsultarAcervo_Click()

Unload Me

ConsultarAcervo.Show

End Sub

Private Sub cmdConsultarUsuario_Click()

Unload Me

ConsultarUsuario.Show

End Sub

Private Sub cmdDevolucao_Click()

Unload Me

Devolucao.Show

End Sub

Private Sub cmdEmprestimo_Click()

Unload Me

Emprestimo.Show

End Sub

Private Sub cmdNovoCadastro_Click()

'=======================================================
'HABILITAR CAIXAS DE TEXTO
'=======================================================

For Each Control In Me.Controls

    If TypeName(Control) = "TextBox" Then
    
        Control.Enabled = True
        
    End If
    
Next Control

'=======================================================
'LIMPAR IMAGEM
'=======================================================

 Image1.Picture = Nothing
 
'=======================================================
'LIMPAR CAIXAS DE TEXTO
'=======================================================

For Each Control In Me.Controls

    If TypeName(Control) = "TextBox" Then
    
        Control.Text = Empty
        
    End If
    
Next Control


'=======================================================
'HABILITAR BOTÃO CADASTRAR
'=======================================================

cmdCadastrar.Enabled = True


'=======================================================
'DESABILITAR BOTÃO NOVO CADASTRO
'=======================================================

cmdNovoCadastro.Enabled = False

End Sub

---

Anderson Diniz

Answer 12

'=======================================================
'DECLARAÇÃO DE VARIÁVEIS
'=======================================================

Dim lin, linha As Long
Dim resposta As VbMsgBoxResult
Dim caminho As String




'=======================================================
'CADASTRAR ITEM
'=======================================================

Sub cadastrar()

'=======================================================
'VERIFICAR SE AS CAIXAS DE TEXTO FORAM PREENCHIDAS
'=======================================================

'PARA CADA CONTROLE DENTRO DO FORMULÁRIO
For Each Control In Me.Controls

    'SE O TIPO DE CONTROLE FOR "TextBox"
    If TypeName(Control) = "TextBox" Then
    
        'SE A CAIXA DE TEXTO ESTIVER VAZIA
        If Control.Text = Empty Then
        
            'MENSAGEM
            MsgBox "Preencha todos os campos."
            
            
            'SAIR DO EVENTO CLICK DO BOTÃO CADASTRAR
            Exit Sub
        
        End If
    
    End If

'PRÓXIMO CONTROLE
Next Control

'=======================================================
'VERIFICAR LINHA EM BRANCO NA PLANILHA
'=======================================================

lin = 40

While Not IsEmpty(Sheets(1).Cells(lin, 1))

lin = lin + 1

Wend

'=======================================================
'VERIFICAR SE O ITEM JÁ ESTÁ CADASTRADO
'=======================================================

linha = 40

While linha <= lin

    If txtISBN.Text = Sheets(1).Cells(linha, 1) Then
    
        MsgBox "ISBN já está cadastrado."
        
        Exit Sub
    
    End If

linha = linha + 1

Wend


'=======================================================
'PREENCHER CÉLULAS
'=======================================================

Sheets(1).Cells(lin, 1) = txtISBN.Text
Sheets(1).Cells(lin, 2) = UCase(txtTitulo.Text)
Sheets(1).Cells(lin, 3) = UCase(txtSecao.Text)
Sheets(1).Cells(lin, 4) = UCase(txtAutor.Text)
Sheets(1).Cells(lin, 5) = UCase(txtEditora.Text)
Sheets(1).Cells(lin, 6) = UCase(txtQuantidade.Text)


'=======================================================
'PREENCHER CAIXAS DE TEXTO
'=======================================================

txtISBN.Text = Sheets(1).Cells(lin, 1)
txtTitulo.Text = Sheets(1).Cells(lin, 2)
txtSecao.Text = Sheets(1).Cells(lin, 3)
txtAutor.Text = Sheets(1).Cells(lin, 4)
txtEditora.Text = Sheets(1).Cells(lin, 5)
txtQuantidade.Text = Sheets(1).Cells(lin, 6)


'=======================================================
'CARREGAR IMAGEM
'=======================================================

resposta = MsgBox("O item foi cadastrado com sucesso." _
& vbCrLf & "Deseja carregar uma imagem?", vbYesNo)

If resposta = vbYes Then
      
pegarCaminho:

    caminho = Application.GetOpenFilename()
    
    If Right(caminho, 4) = ".jpg" Or Right(caminho, 4) = ".bmp" Then
    
    On Error Resume Next
    Image1.Picture = LoadPicture(caminho)
    Image1.PictureSizeMode = fmPictureSizeModeStretch
    
    'C:\pasta\arquivo.jpg
     
    origem = caminho
    
    destino = "C:\Users\anderson\Desktop\demonstração do " & _
    "programa da biblioteca\IMAGENS\" & Sheets(1).Cells(lin, 1).Value & Right(caminho, 4)
    
    'C:\pasta\codigo.jpg
    
    FileCopy origem, destino
    
    Sheets(1).Cells(lin, 7) = destino
        
    Else

' O controle Image aceita arquivos nos seguintes formatos:

'.bmp, .cur, .gif, .ico, .jpg, .wmf
    
    MsgBox "Escolha uma imagem no formato .bmp ou . jpg", vbOKOnly, _
    "Formato de imagem inválido"
    
    resposta = MsgBox("Deseja carregar outra imagem?", vbYesNo)

If resposta = vbYes Then
    
    GoTo pegarCaminho
    
End If
    
    End If
     
    
End If


'=======================================================
'DESABILITAR CAIXAS DE TEXTO
'=======================================================

For Each Control In Me.Controls

    If TypeName(Control) = "TextBox" Then
    
        Control.Enabled = False
        
    End If
    
Next Control

'=======================================================
'HABILITAR BOTÃO NOVO CADASTRO
'=======================================================

cmdNovoCadastro.Enabled = True

'=======================================================
'DESABILITAR BOTÃO CADASTRAR
'=======================================================

cmdCadastrar.Enabled = False


'=======================================================
'SALVAR ARQUIVO
'=======================================================


ThisWorkbook.Save

End Sub

Private Sub cmdAlterarCadastroAcervo_Click()

Unload Me

AlterarCadastroAcervo.Show

End Sub

Private Sub cmdAlterarCadastroUsuario_Click()

Unload Me

AlterarCadastroUsuario.Show

End Sub

Private Sub cmdCadastrar_Click()

'=======================================================
'CADASTRAR ITEM
'=======================================================

cadastrar

End Sub

Private Sub cmdCadastrarUsuario_Click()

Unload Me

CadastrarUsuario.Show

End Sub

Private Sub cmdConsultarAcervo_Click()

Unload Me

ConsultarAcervo.Show

End Sub

Private Sub cmdConsultarUsuario_Click()

Unload Me

ConsultarUsuario.Show

End Sub

Private Sub cmdDevolucao_Click()

Unload Me

Devolucao.Show

End Sub

Private Sub cmdEmprestimo_Click()

Unload Me

Emprestimo.Show

End Sub

Private Sub cmdNovoCadastro_Click()

'=======================================================
'HABILITAR CAIXAS DE TEXTO
'=======================================================

For Each Control In Me.Controls

    If TypeName(Control) = "TextBox" Then
    
        Control.Enabled = True
        
    End If
    
Next Control

'=======================================================
'LIMPAR IMAGEM
'=======================================================

 Image1.Picture = Nothing
 
'=======================================================
'LIMPAR CAIXAS DE TEXTO
'=======================================================

For Each Control In Me.Controls

    If TypeName(Control) = "TextBox" Then
    
        Control.Text = Empty
        
    End If
    
Next Control


'=======================================================
'HABILITAR BOTÃO CADASTRAR
'=======================================================

cmdCadastrar.Enabled = True


'=======================================================
'DESABILITAR BOTÃO NOVO CADASTRO
'=======================================================

cmdNovoCadastro.Enabled = False

End Sub

---

Anderson Diniz

Obrigado Anderson... vou tentar fazer as adaptações necessárias aqui e posto o resultado mais tarde...

Answer 13

'Aqui é selecionado a Planilha com seus dados (Plan1) no nosso exemplo
    With Plan1.Range("A:A")
 
        'Aqui onde será digitado o que procurar
 
        Set C = .Find(TextBox2.Value, LookIn:=xlValues, LOOKAT:=xlWhole)
 
        'Aqui outra tomada de decisão, caso encontre sua pesquisa, será retornado nas caixas de textbox.
        If Not C Is Nothing Then
            TextBox2.Text = C.Offset(0, 1)
            TextBox3.Text = C.Offset(0, 2)
 
            'Fim da Pesquisa
        End If
 
        'Tomada de decisão em caso de não haver nenhum resultado
        If C Is Nothing Then
 
            'Sua mensagem ao usuário aqui
            MsgBox ("Nome Não Encontrado!!!"), vbOKOnly, ("Seu Aplicativo Pesquisando Dados")
        End If
 
        'Fim da Pesquisa
    End With

---

Anderson Diniz

Answer 14

'Aqui é selecionado a Planilha com seus dados (Plan1) no nosso exemplo
    With Plan1.Range("A:A")
 
        'Aqui onde será digitado o que procurar
 
        Set C = .Find(TextBox2.Value, LookIn:=xlValues, LOOKAT:=xlWhole)
 
        'Aqui outra tomada de decisão, caso encontre sua pesquisa, será retornado nas caixas de textbox.
        If Not C Is Nothing Then
            TextBox2.Text = C.Offset(0, 1)
            TextBox3.Text = C.Offset(0, 2)
 
            'Fim da Pesquisa
        End If
 
        'Tomada de decisão em caso de não haver nenhum resultado
        If C Is Nothing Then
 
            'Sua mensagem ao usuário aqui
            MsgBox ("Nome Não Encontrado!!!"), vbOKOnly, ("Seu Aplicativo Pesquisando Dados")
        End If
 
        'Fim da Pesquisa
    End With

---

Anderson Diniz

Anderson, desculpa mas como faço para selecionar a célula junto com o resultado da pesquisa, é que preciso fora o retorno da pesquisa, inserir dados também na mesma linha de onde o meu item está.

Answer 15

Ali onde está:

C.Offset(0, 1)

Você também pode pegar a linha da célula:

linha = C.Row

---

Anderson Diniz

Answer 16

Ali onde está:

C.Offset(0, 1)

Você também pode pegar a linha da célula:

linha = C.Row

---

Anderson Diniz

Desculpa eu vacilei na segunda dúvida... o que eu preciso é quando ele retornar as informações conforme vc já me ajudou na pesquisa, ele deixar eu inserir dados na linha de retorno do mesmo...

O meu inicio de pesquisa é via NF e eu já consegui trazer os outros dados (graças a sua ajuda), mas perceba que temos linhas que falta informações e eu preciso preencher... como eu faço isso?

Answer 17

Se você já sabe o endereço da célula em que vai colocar algum valor:

ThisWorkbook.Sheets("Planilha1").Range("E5")= 124

Se você já sabe o endereço da célula em que vai colocar algum texto:

ThisWorkbook.Sheets("Planilha1").Range("E5")= "palavra"

Se quiser usar a linha da célula que retornou o valor:

ThisWorkbook.Sheets("Planilha1").Range("E" & C.row)= "palavra"

---

Anderson Diniz

Answer 18

Se quiser colocar o texto na célula que está selecionada no momento:

Sub teste()

Selection.Value = "texto"

End Sub

---

Anderson Diniz