Coleção 15.000 Macros MS Excel VBA

   Mega_Colecao Macros de Macros MS Excel VBA
      

Curso Completo MS Excel VBA

Excel VBA Video Aulas

 Aprenda Excel VBA - SaberExcel VBA - Video Aulas       
Com Simplicidade e Facilidade,
Escrevendo menos e fazendo mais
Linha de raciocínio de fácil entendimento...

 

20.000 Planilhas MS Excel VBA

 20.000 Planilhas Microsoft Excel VBA, treinamentos, busca, pesquisas, desenvolvimento a partir de exemplos prontos, estudos e pratica com planilhas prontas.

SBL Excel VBA Cadastro Lancamentos e buscas

Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções

Estes Macro do Aplicativo Microsoft Excel VBA(Visual Basic Application), faremos um exemplo de cadastro e busca.
Exemplo de planilha como Cadastrar a partir da Própria folha de planilha, com macros do Excel VBA que faremos um formulário para cadastro que enviará os dados para outra folha de planilha, isto para planilha Banco_Dados, faremos buscas nesta planilha (Cadastro) usaremos: Listas Suspensas, objetos Combobox, e Options.
Faremos um sistema de busca em vários objetos por várias colunas.
Baixe o exemplo de planilha no final da página Bons Estudos.

Seja um assinante Saberexcel : Procedimentos de Aquisição dos produtos Didáticos SaberExcel

 '//====================='


Sub sbx_novo()  ‘novo cadastro planilha excel 
    x = Plan4.Cells(Rows.Count, "a").End(xlUp).Row + 1
   Plan1.Shapes("btALTERAR").Visible = True
  '  Plan1.Shapes("btSALVAR").Visible = True
   'Plan1.Unprotect ' caso esteja
    Plan1.Cells(5, "e") = "" '
    Plan1.Cells(8, "e") = ""  'codigo
    Plan1.Cells(10, "e") = "" 'nome
    Plan1.Cells(10, "n") = "" 'sexo
    Plan1.Cells(12, "e") = "" 'endereço
    Plan1.Cells(12, "n") = "" 'bairro
    Plan1.Cells(14, "e") = "" 'cidade
    Plan1.Cells(14, "L") = "" 'estado    
    Plan1.Cells(14, "P") = "" 'cep
    Plan1.Cells(16, "e") = "" 'faixa etaria
   Plan1.Cells(16, "L") = "" ' data nascimento
    Plan1.Cells(8, "e").Value = (x - 3)
    Plan1.Cells(10, "e").Activate
End Sub

 '//====================='
Sub sbx_altera_dados()
x = Plan4.Cells(Rows.Count, "a").End(xlUp).Row
If Plan1.Cells(10, "e") = "" Then MsgBox " não há registro para alterar", vbCritical, "Escola Saberexcel VBA Estudos®": Exit Sub
For i = 4 To Plan.Cells(Rows.Count, "b").End(xlUp).Row
    If Plan4.Cells(i, "a") = Plan1.Cells(8, "e") Then
       Plan4.Cells(i, "b") = Plan1.Cells(10, "e") 'nome
       Plan4.Cells(i, "c") = Plan1.Cells(10, "n") 'sexo
       Plan4.Cells(i, "d") = Plan1.Cells(12, "e") 'endereço
       Plan4.Cells(i, "e") = Plan1.Cells(12, "n") 'bairro
       Plan4.Cells(i, "f") = Plan1.Cells(14, "e") 'cidade
       Plan4.Cells(i, "g") = Plan1.Cells(14, "L") 'estado
       Plan4.Cells(i, "h") = Plan1.Cells(14, "P") 'cep
       Plan4.Cells(i, "i") = Plan1.Cells(16, "e") 'faixa etária
       Plan4.Cells(i, "j") = Plan1.Cells(16, "L") 'data nascimento
    End If
Next i
MsgBox ("dados foram alterados com sucesso!"), vbInformation, "Escola Saberexcel VBA Estudos®"
End Sub
 '//====================='
Sub sbx_salvar_dados()
'localizar a ultima linha na plan4 + 1(proxima em branco)
I
f Plan1.Cells(10, "e").Value = "" Then MsgBox "dados incosistentes...", vbCritical, "Escola Saberexcel VBA Estudos®": Exit Sub
Plan1.Shapes("btALTERAR").Visible = True
x = Plan4.Cells(Rows.Count, "a").End(xlUp).Row + 1
For i = 2 To x    
     If Plan4.Cells(i, "a").Value = Plan1.Cells(8, "e") Then MsgBox "Cadastro já existente...", vbCritical, "Escola Saberexcel VBA Estudos®": Exit Sub
    Exit For
Next i
    Plan4.Cells(x, "a") = Plan1.Cells(8, "e")  'codigo
    Plan4.Cells(x, "b") = Plan1.Cells(10, "e") 'nome
    Plan4.Cells(x, "c") = Plan1.Cells(10, "n") 'sexo
    Plan4.Cells(x, "d") = Plan1.Cells(12, "e") 'endereço
    Plan4.Cells(x, "e") = Plan1.Cells(12, "n") 'bairro
    Plan4.Cells(x, "f") = Plan1.Cells(14, "e") 'cidade
    Plan4.Cells(x, "g") = Plan1.Cells(14, "L") 'estado
    Plan4.Cells(x, "h") = Plan1.Cells(14, "P") 'cep
    Plan4.Cells(x, "i") = Plan1.Cells(16, "e") 'faixa etaria
    Plan4.Cells(x, "j") = Plan1.Cells(16, "L") ' data nascimento
    MsgBox "dados foram salvos com sucesso!!", vbInformation, "Escola Saberexcel VBA Estudos®"

    '//========'limpando para novos dados ...

    Plan1.Cells(8, "e") = "" 'codigo
    Plan1.Cells(10, "e") = "" 'nome
    Plan1.Cells(10, "n") = "" 'sexo
    Plan1.Cells(12, "e") = "" 'endereço
    Plan1.Cells(12, "n") = "" 'bairro
    Plan1.Cells(14, "e") = "" 'cidade
    Plan1.Cells(14, "L") = "" 'estado
    Plan1.Cells(14, "P") = "" 'cep
    Plan1.Cells(16, "e") = "" 'faixa etaria
    Plan1.Cells(16, "L") = "" ' data nascimento
    Plan1.Cells(8, "e").Value = (x - 3)
    Plan1.Cells(10, "e").Activate
   ' Plan1.Shapes("btSALVAR").Visible = False
End Sub
 '//====================='
'busca efetuada na plan2'
Sub sby_autofiltro_masculino()
Dim i As Integer
wLin = 11
'x = Plan2.Cells(Rows.Count, "b").End(xlUp).Row + 2
Plan2.Range(Plan2.Cells(11, "b"), Plan2.Cells(23, "h")).ClearContents
For i = 2 To Plan4.Cells(Rows.Count, "a").End(xlUp).Row
   If Plan4.Cells(i, "c").Value = "Masculino" Then
       Plan4.Cells(i, "a").Resize(, 7).Copy Plan2.Cells(wLin, "b")
       wLin = wLin + 1
    End If
Next i
End Sub
 '//====================='
Sub sby_autofiltro_feminino()
Dim i As Integer
wLin = 11
'x = Plan4.Cells(Rows.Count, "b").End(xlUp).Row + 1
Plan2.Range(Plan2.Cells(11, "b"), Plan2.Cells(23, "h")).ClearContents
F
or i = 2 To Plan4.Cells(Rows.Count, "a").End(xlUp).Row
    If Plan4.Cells(i, "c").Value = "Feminino" Then
       Plan4.Cells(i, "a").Resize(, 7).Copy Plan2.Cells(wLin, "b")
       wLin = wLin + 1
    End If
Next i
End Sub
 '//====================='
Sub sby_autofiltro_faixa_etaria()
Dim i As Integer
wLin = 11
'x = Plan4.Cells(Rows.Count, "b").End(xlUp).Row + 2
Plan2.Range(Plan2.Cells(11, "b"), Plan2.Cells(23, "h")).ClearContents
For i = 2 To Plan4.Cells(Rows.Count, "a").End(xlUp).Row
    If Plan4.Cells(i, "i").Value = Plan2.[E3] Then
       Plan4.Cells(i, "a").Resize(, 7).Copy Plan2.Cells(wLin, "b")
       wLin = wLin + 1
    End If
Next i
End Sub
 '//====================='
Sub sby_imprimir()
Dim resposta As String
resposta = MsgBox("deseja imprimir esta area(B11:H23)da planilha?", vbYesNo + vbinformation, "Escola aberexcel VBA Estudos®")
If resposta = 6 Then ' 6 = vbyes e 7 = vbNo
   ActiveSheet.PageSetup.PrintArea = "$B$11:$H$23"
   ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
                IgnorePrintAreas:=False
End If
End Sub


Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos
Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.




 u - Procedimentos de Aquisição dos produtos Didáticos SaberExcel
 Baixe o exemplo de planilha contendo os macros acima:
icon SBL Excel VBA Cadastro Lancamentos e buscas (81.38 kB)  


  Excel VBA cadastrar Monitorias IRD Fixa (58.5 kB)

Você está aqui: Home Excel VBA - Dicas Livre Excel VBA - Dicas Livre Excel VBA - Cadastros Diversos SBL Excel VBA Cadastro Lancamentos e buscas