Ir para conteúdo
Fórum Script Brasil

Pedro Miguel Gomes

Membros
  • Total de itens

    4
  • Registro em

  • Última visita

Posts postados por Pedro Miguel Gomes

  1. Estou com um problema no código que quando dou ENTER em uma textbox vazia ele redireciona-me para o código com uma mensagem de erro, como eu posso fazer para ele não me redirecionar para o código, e mandar uma mensagebox com uma mensagem de erro.

    Option Explicit
    
    Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        If KeyCode = 13 Then Call Filtro(TextBox1.Text, ComboBox1.Text)
    End Sub
    
    Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        If KeyCode = 13 Then Call Filtro(TextBox2.Text, ComboBox2.Text)
    End Sub
    
    Private Sub TextBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        If KeyCode = 13 Then Call Filtro(TextBox3.Text, ComboBox3.Text)
    End Sub
    
    Private Sub UserForm_Initialize()
        ComboBox1.RowSource = "Relatório!C1:C11"
        ComboBox2.RowSource = "Relatório!C1:C11"
        ComboBox3.RowSource = "Relatório!C1:C11"
    End Sub
    
    Sub Filtro(ByVal Pesquisar_Imo As String, Campo As String)
        Dim Coluna  As Integer
        Dim Area    As Range
        
        Set Area = ThisWorkbook.Sheets("Dados_Imobilizado").[A1:K1]
        Coluna = WorksheetFunction.Match(Campo, Area, 0)
        If Pesquisar_Imo <> "" Then
            If IsNumeric(Pesquisar_Imo) = False Then Pesquisar_Imo = "*" & Pesquisar_Imo & "*"
            Call Area.AutoFilter(Field:=Coluna, Criteria1:=Pesquisar_Imo)
            Call CopiaTabela
            Call PreencheListBox
        End If
    End Sub
    
    Sub CopiaTabela()
        ThisWorkbook.Sheets("Auxiliar").[N:X].Clear
        ThisWorkbook.Sheets("Dados_Imobilizado").[A1].CurrentRegion.Copy
        ThisWorkbook.Sheets("Auxiliar").[N1].PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End Sub
    
    Sub PreencheListBox()
        Dim Area    As Range
        Set Area = ThisWorkbook.Sheets("Auxiliar").[N1].CurrentRegion
        ListBox1.ColumnCount = Area.Columns.Count
        ListBox1.ColumnHeads = True
        ListBox1.RowSource = "Auxiliar!" & Area.Offset(1).Address
    End Sub

    Link do programa: 

    https://drive.google.com/file/d/1WTRoJ_4EzZGMsuYPkUoKNjbgCYEIO2TB/view?usp=sharing

     

    Captura de ecrã 2021-03-24 135441.png

    Captura de ecrã 2021-03-24 135423.png

  2. Sou estudante de Programação e nunca tinha usado VBA e tenho de entregar um trabalho, mas nunca tive formação nesta linguagem, e estou a ter problemas  no programa na parte de Pesquisar registros com filtros, já tentei ao máximo fazer seguindo tutoriais na internet, até que uma pessoua me ajudou e mandou-me codia e disse para fazer um passos só que eu não sei seguir esses passos.

     Fico muito agradecido se alguém me conseguir ajudar.

       

    O que a pessoa me indicou:

    " Para testar o código coloque um filtro na planilha Dados no range A1:L1 e crie uma planilha com o nome de Auxiliar. Cole o código no formulário Pesquisar. "

    Option Explicit
    
    Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        If KeyCode = 13 Then Call Filtro(TextBox1.Text, ComboBox1.Text)
    End Sub
    
    Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        If KeyCode = 13 Then Call Filtro(TextBox2.Text, ComboBox2.Text)
    End Sub
    
    Private Sub TextBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        If KeyCode = 13 Then Call Filtro(TextBox3.Text, ComboBox3.Text)
    End Sub
    
    Private Sub UserForm_Initialize()
        ComboBox1.RowSource = "Relatório!A1:A12"
        ComboBox2.RowSource = "Relatório!A1:A12"
        ComboBox3.RowSource = "Relatório!A1:A12"
    End Sub
    
    Sub Filtro(ByVal Pesquisa As String, Campo As String)
        Dim Coluna  As Integer
        Dim Area    As Range
        
        Set Area = ThisWorkbook.Sheets("Dados").[A1:L1]
        Coluna = WorksheetFunction.Match(Campo, Area, 0)
        If Pesquisa <> "" Then
            If IsNumeric(Pesquisa) = False Then Pesquisa = "*" & Pesquisa & "*"
            Call Area.AutoFilter(Field:=Coluna, Criteria1:=Pesquisa)
            Call CopiaTabela
            Call PreencheListBox
        End If
    End Sub
    
    Sub CopiaTabela()
        ThisWorkbook.Sheets("Auxiliar").[A:L].Clear
        ThisWorkbook.Sheets("Dados").[A1].CurrentRegion.Copy
        ThisWorkbook.Sheets("Auxiliar").[A1].PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End Sub
    
    Sub PreencheListBox()
        Dim Area    As Range
        Set Area = ThisWorkbook.Sheets("Auxiliar").[A1].CurrentRegion
        ListBox1.ColumnCount = Area.Columns.Count
        ListBox1.ColumnHeads = True
        ListBox1.RowSource = "Auxiliar!" & Area.Offset(1).Address
    End Sub

    Link do Programa: 

    https://drive.google.com/file/d/1ucJVL5Ijg0IcDqaFzoJi8aiMPb0NCbjI/view?usp=sharing

×
×
  • Criar Novo...