| Descricao: |
 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
|