Excel vba cadastro clientes propria planilha

Dom, 16 de Junho de 2013 16:52 Expedito Marcondes
Imprimir

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

Esses macros fazem um cadastro da própria planilha, como se fosse um formulário, usando as células da folha
planilhas, envia dados para cadastro em outra determinada folha de planilhas..
'//==============='
Global Const s = vbInformation
Global Const a = "Escola Saberexcel VBA Estudos®"
Global Const b = "Aprenda Microsoft Excel VBA, Praticando"
Global Const e = "Verificado inconsistencia de digitação!"
Global Const r = vbCritical
'//==============='
Sub sbx_cadastra_busca()
Dim i As Long
Plan1.Shapes("sbx_altera").Visible = True
Plan1.Shapes("sbx_gravar").Visible = False
 For i = 2 To Plan2.Cells(Rows.Count, "a").End(xlUp).Row
  If Plan2.Cells(i, "a").Value = Plan1.Cells(6, "AM") Then
      Plan1.Cells(6, "o").Value = Plan2.Cells(i, "c")
       Plan1.Cells(8, "o").Value = Plan2.Cells(i, "d")    'nome fantasia
        Plan1.Cells(8, "am").Value = Plan2.Cells(i, "e")   'tipo pessoa
        If Left(Cells(8, "am"), 3) = "JUR" Then
            Plan1.Cells(10, "i").Value = "CNPJ Nº "
            Plan2.Cells(i, "f").NumberFormat = "##"".""###"".""###""/""####""-""##"
         Else
            Plan1.Cells(10, "i").Value = "CPF Nº "
            Plan2.Cells(i, "f").NumberFormat = "###"".""###"".""###""-""##"
         End If
         Plan1.Cells(10, "o").Value = Plan2.Cells(i, "f")   'cnpj/cpf
          Plan1.Cells(10, "af").Value = Plan2.Cells(i, "g")  'insc.Est
           Plan1.Cells(12, "o").Value = Plan2.Cells(i, "h")  'Fone_1
            Plan1.Cells(12, "af").Value = Plan2.Cells(i, "i")  'Fone_2
             Plan1.Cells(14, "o").Value = Plan2.Cells(i, "j")   'Fax
              Plan1.Cells(14, "af").Value = Plan2.Cells(i, "k")  'celular
               Plan1.Cells(16, "o").Value = Plan2.Cells(i, "l")   'contato
                Plan1.Cells(16, "af").Value = Plan2.Cells(i, "m")  'email
               Plan1.Cells(18, "o").Value = Plan2.Cells(i, "n")   'ramo atividade
              Plan1.Cells(18, "am").Value = Plan2.Cells(i, "o")  'data Fundacao
             Plan1.Cells(20, "o").Value = Plan2.Cells(i, "p")   'cep
            Plan1.Cells(20, "z").Value = Plan2.Cells(i, "q")   'cidade
           Plan1.Cells(20, "am").Value = Plan2.Cells(i, "r")  'uf
          Plan1.Cells(22, "o").Value = Plan2.Cells(i, "s")   'endereco
        Plan1.Cells(22, "am").Value = Plan2.Cells(i, "t")  'num
       Plan1.Cells(24, "o").Value = Plan2.Cells(i, "u")   'bairro
      Plan1.Cells(24, "af").Value = Plan2.Cells(i, "v")  'site
     Plan1.Cells(26, "o").Value = Plan2.Cells(i, "w")   'observ
    Plan1.Cells(29, "af").Value = Plan2.Cells(i, "b")  'data
  End If
 Next i
Plan1.[g1].Select
End Sub
'//==============='
Sub sbx_cadastra_altera()
Dim i As Long
For i = 2 To Plan2.Cells(Rows.Count, "a").End(xlUp).Row
If Plan2.Cells(i, "a").Value = Plan1.Cells(6, "AM") Then
    Plan2.Cells(i, "c") = Plan1.Cells(6, "o").Value
     Plan2.Cells(i, "d") = Plan1.Cells(8, "o").Value     'nome fantasia
      Plan2.Cells(i, "e") = Plan1.Cells(8, "am").Value    'tipo pessoa
       Plan2.Cells(i, "f") = Plan1.Cells(10, "o").Value    'cnpj/cpf
        Plan2.Cells(i, "g") = Plan1.Cells(10, "af").Value   'insc.Est
         Plan2.Cells(i, "h") = Plan1.Cells(12, "o").Value    'Fone_1
          Plan2.Cells(i, "i") = Plan1.Cells(12, "af").Value    'Fone_2
           Plan2.Cells(i, "j") = Plan1.Cells(14, "o").Value    'Fax
            Plan2.Cells(i, "k") = Plan1.Cells(14, "af").Value   'celular
             Plan2.Cells(i, "l") = Plan1.Cells(16, "o").Value    'contato
              Plan2.Cells(i, "m") = Plan1.Cells(16, "af").Value   'email
               Plan2.Cells(i, "n") = Plan1.Cells(18, "o").Value    'ramo atividade
              Plan2.Cells(i, "o") = Plan1.Cells(18, "am").Value   'data Fundacao
             Plan2.Cells(i, "p") = Plan1.Cells(20, "o").Value    'cep
            Plan2.Cells(i, "q") = Plan1.Cells(20, "z").Value    'cidade
           Plan2.Cells(i, "r") = Plan1.Cells(20, "am").Value   'uf
          Plan2.Cells(i, "s") = Plan1.Cells(22, "o").Value    'endereco
         Plan2.Cells(i, "t") = Plan1.Cells(22, "am").Value   'num
        Plan2.Cells(i, "u") = Plan1.Cells(24, "o").Value    'bairro
       Plan2.Cells(i, "v") = Plan1.Cells(24, "af").Value   'site
      Plan2.Cells(i, "w") = Plan1.Cells(26, "o").Value    'observ
   Plan2.Cells(i, "b") = Plan1.Cells(29, "af").Value  'data
  End If
Next i
Plan1.[g1].Select
MsgBox ("Alteração realizada com sucesso!!" & vbCrLf & _
        Plan1.Cells(6, "o").Value) & vbCrLf & b, s, a
sbx_concatenar_montar_combobox
End Sub
'//================'
Sub sbx_novo_cadastro()
 Plan1.Shapes("sbx_altera").Visible = False
Plan1.Shapes("sbx_gravar").Visible = True
UL = Plan2.Cells(Rows.Count, "a").End(xlUp).Row + 1
 Plan1.Cells(6, "am").Value = UL - 1
  Plan1.Cells(6, "o").Value = ""
   Plan1.Cells(8, "o").Value = ""    'nome fantasia
    Plan1.Cells(8, "am").Value = ""   'tipo pessoa
     Plan1.Cells(10, "o").Value = ""   'cnpj/cpf
      Plan1.Cells(10, "af").Value = ""  'insc.Est
       Plan1.Cells(12, "o").Value = ""   'Fone_1
        Plan1.Cells(12, "af").Value = ""  'Fone_2
         Plan1.Cells(14, "o").Value = ""   'Fax
          Plan1.Cells(14, "af").Value = ""  'celular
           Plan1.Cells(16, "o").Value = ""   'contato
            Plan1.Cells(16, "af").Value = ""  'email
           Plan1.Cells(18, "o").Value = ""   'ramo atividade
          Plan1.Cells(18, "am").Value = ""  'data Fundacao
         Plan1.Cells(20, "o").Value = ""   'cep
        Plan1.Cells(20, "z").Value = ""    'cidade
       Plan1.Cells(20, "am").Value = ""  'uf
      Plan1.Cells(22, "o").Value = ""   'endereco
     Plan1.Cells(22, "am").Value = ""  'num
    Plan1.Cells(24, "o").Value = ""   'bairro
   Plan1.Cells(24, "af").Value = ""  'site
  Plan1.Cells(26, "o").Value = ""   'observ
 Plan1.Cells(29, "af").Value = ""  'data
sbx_concatenar_montar_combobox
End Sub
'//==============='
Sub sbx_grava_dados()
  Dim UL  As Long

UL = Plan2.Cells(Rows.Count, "a").End(xlUp).Row + 1
'//========'verifica inconsistencia
If Plan1.Cells(6, "o").Value = "" Then MsgBox "Digite a 'Razão Social'" & vbCrLf & e, r, a: Plan1.Cells(6, "o").Select: Exit Sub
 If Plan1.Cells(8, "o").Value = "" Then MsgBox "Digite 'Nome Fantasia'" & vbCrLf & e, r, a: Plan1.Cells(8, "o").Select: Exit Sub
  If Plan1.Cells(8, "am").Value = "" Then MsgBox "Digite 'Tipo Pessoa'" & vbCrLf & e, r, a: Plan1.Cells(8, "am").Select: Exit Sub
   If Plan1.Cells(10, "o").Value = "" Then MsgBox "Digite 'Cnpj/Cpf'" & vbCrLf & e, r, a: Plan1.Cells(10, "o").Select: Exit Sub
    If Plan1.Cells(10, "af").Value = "" Then MsgBox "Digite 'Insc.Est'" & vbCrLf & e, r, a: Plan1.Cells(10, "af").Select: Exit Sub
     If Plan1.Cells(12, "o").Value = "" Then MsgBox " Digite 'Fone_1'" & vbCrLf & e, r, a: Plan1.Cells(10, "af").Select: Exit Sub
      If Plan1.Cells(12, "af").Value = "" Then MsgBox " Digite 'Fone_2'" & vbCrLf & e, r, a: Plan1.Cells(12, "af").Select: Exit Sub
       If Plan1.Cells(14, "o").Value = "" Then MsgBox " Digite 'Fax'" & vbCrLf & e, r, a: Plan1.Cells(14, "o").Select: Exit Sub
        If Plan1.Cells(14, "af").Value = "" Then MsgBox " Digite 'Celular'" & vbCrLf & e, r, a: Plan1.Cells(14, "o").Select: Exit Sub
         If Plan1.Cells(16, "o").Value = "" Then MsgBox " Digite 'Contato'" & vbCrLf & e, r, a: Plan1.Cells(16, "o").Select: Exit Sub
          If Plan1.Cells(16, "af").Value = "" Then MsgBox " Digite 'Email'" & vbCrLf & e, r, a: Plan1.Cells(16, "af").Select: Exit Sub
           If Plan1.Cells(18, "o").Value = "" Then MsgBox " Digite o 'Ramo Atividade'" & vbCrLf & e, r, a: Plan1.Cells(18, "o").Select: Exit Sub
          If Plan1.Cells(18, "am").Value = "" Then MsgBox " Digite a 'Data da Fundacao'" & vbCrLf & e, r, a: Plan1.Cells(18, "am").Select: Exit Sub
         If Plan1.Cells(20, "o").Value = "" Then MsgBox " Digite o 'Cep'" & vbCrLf & e, r, a: Plan1.Cells(20, "o").Select: Exit Sub
        If Plan1.Cells(20, "z").Value = "" Then MsgBox " Digite a 'Cidade'" & vbCrLf & e, r, a: Plan1.Cells(20, "z").Select: Exit Sub
       If Plan1.Cells(20, "am").Value = "" Then MsgBox "Digite o estado 'UF'" & vbCrLf & e, r, a: Plan1.Cells(20, "am").Select: Exit Sub
      If Plan1.Cells(22, "o").Value = "" Then MsgBox "Digite o 'Endereco'" & vbCrLf & e, r, a: Plan1.Cells(22, "o").Select: Exit Sub
     If Plan1.Cells(22, "am").Value = "" Then MsgBox "Digite 'Número' do Endereço" & vbCrLf & e, r, a: Plan1.Cells(22, "am").Select: Exit Sub
    If Plan1.Cells(24, "o").Value = "" Then MsgBox "Digite o 'Bairro'" & vbCrLf & e, r, a: Plan1.Cells(24, "o").Select: Exit Sub
   If Plan1.Cells(24, "af").Value = "" Then MsgBox "digite o 'Site'" & vbCrLf & e, r, a: Plan1.Cells(24, "af").Select: Exit Sub
  If Plan1.Cells(26, "o").Value = "" Then MsgBox "Digite a 'Observação' " & vbCrLf & e, r, a: Plan1.Cells(26, "o").Select: Exit Sub
If Plan1.Cells(29, "af").Value = "" Then MsgBox "Digite a 'Data'" & vbCrLf & e, r, a: Plan1.Cells(29, "af").Select: Exit Sub
'//=============='salvar os dados
Plan2.Cells(UL, "a") = Plan1.Cells(6, "am")    'codigo
 Plan2.Cells(UL, "c") = Plan1.Cells(6, "o")     'razao social
  Plan2.Cells(UL, "d") = Plan1.Cells(8, "o")     'nome fantasia
   Plan2.Cells(UL, "e") = Plan1.Cells(8, "am")    'tipo pessoa
    Plan2.Cells(UL, "f") = Plan1.Cells(10, "o")    'cnpj/cpf
     Plan2.Cells(UL, "g") = Plan1.Cells(10, "af")   'insc.Est
      Plan2.Cells(UL, "h") = Plan1.Cells(12, "o")    'Fone_1
       Plan2.Cells(UL, "i") = Plan1.Cells(12, "af")   'Fone_2
        Plan2.Cells(UL, "j") = Plan1.Cells(14, "o")    'Fax
         Plan2.Cells(UL, "k") = Plan1.Cells(14, "af")   'celular
          Plan2.Cells(UL, "l") = Plan1.Cells(16, "o")    'contato
           Plan2.Cells(UL, "m") = Plan1.Cells(16, "af")   'email
            Plan2.Cells(UL, "n") = Plan1.Cells(18, "o")    'ramo atividade
           Plan2.Cells(UL, "o") = Plan1.Cells(18, "am")   'data Fundacao
          Plan2.Cells(UL, "p") = Plan1.Cells(20, "o")    'cep
         Plan2.Cells(UL, "q") = Plan1.Cells(20, "z")    'cidade
        Plan2.Cells(UL, "r") = Plan1.Cells(20, "am")   'uf
       Plan2.Cells(UL, "s") = Plan1.Cells(22, "o")    'endereco
      Plan2.Cells(UL, "t") = Plan1.Cells(22, "am")   'num
     Plan2.Cells(UL, "u") = Plan1.Cells(24, "o")    'bairro
    Plan2.Cells(UL, "v") = Plan1.Cells(24, "af")   'site
   Plan2.Cells(UL, "w") = Plan1.Cells(26, "o")   'observ
  Plan2.Cells(UL, "b") = Plan1.Cells(29, "af")   'data
 MsgBox ("Dados Gravados com Sucesso " & vbCrLf & _
         Plan1.Cells(6, "o").Value), s, a
'//=================='limpando dados para novo cadastro
Plan1.Cells(6, "am").Value = UL
 Plan1.Cells(6, "o").Value = ""
  Plan1.Cells(8, "o").Value = ""    'nome fantasia
   Plan1.Cells(8, "am").Value = ""   'tipo pessoa
    Plan1.Cells(10, "o").Value = ""   'cnpj/cpf
     Plan1.Cells(10, "af").Value = ""  'insc.Est
      Plan1.Cells(12, "o").Value = ""   'Fone_1
       Plan1.Cells(12, "af").Value = ""  'Fone_2
        Plan1.Cells(14, "o").Value = ""   'Fax
         Plan1.Cells(14, "af").Value = ""  'celular
          Plan1.Cells(16, "o").Value = ""   'contato
           Plan1.Cells(16, "af").Value = ""  'email
            Plan1.Cells(18, "o").Value = ""   'ramo atividade
           Plan1.Cells(18, "am").Value = ""  'data Fundacao
          Plan1.Cells(20, "o").Value = ""   'cep
         Plan1.Cells(20, "z").Value = ""   'cidade
        Plan1.Cells(20, "am").Value = ""  'uf
       Plan1.Cells(22, "o").Value = ""   'endereco
      Plan1.Cells(22, "am").Value = ""  'num
     Plan1.Cells(24, "o").Value = ""   'bairro
    Plan1.Cells(24, "af").Value = ""  'site
   Plan1.Cells(26, "o").Value = ""   'observ
  Plan1.Cells(29, "af").Value = ""  'data
 Plan1.Shapes("sbx_altera").Visible = True
Plan1.Shapes("sbx_gravar").Visible = False
sbx_concatenar_montar_combobox
End Sub
'//==================='
Sub sbx_visualizar_macros_wordpad()
ActiveSheet.Shapes.Range(Array("sbxMACROS")).Select
Selection.Verb Verb:=xlPrimary
[h1].Select
End Sub
'//==================='
Sub sbx_concatenar_montar_combobox()
'combobox 'caixa de controle' do formulário do excel
Dim i As Long
 For i = 2 To Plan2.Cells(Rows.Count, "a").End(xlUp).Row
   If Plan2.Cells(i, "a") <> "" Then
     Plan2.Cells(i, "y").Value = Plan2.Cells(i, "a").Value & " - " & _
     Plan2.Cells(i, "c").Value
  End If
Next i
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.



  Baixe o exemplo de planilha com os macros acima
icon Excel vba cadastro clientes propria planilha (158.94 KB)

Tags:
Última atualização em Dom, 16 de Junho de 2013 17:15