Excel VBA - Cadastro

  • - Acesso Livre (há alguns arquivos nesta categoria com restrição de acesso - faça o login ou Registre-se)
    Acesso Livre - Registrados (REGISTRE-SE!)
  • Documentos

    Ordenar por : Nome | Data | Acessos [ Ascendente ]

    vba cadastro cadastrando na propria planilha vba cadastro cadastrando na propria planilha

    popular!
    Adicionado em: 18/11/2010
    Modificado em: 18/11/2010
    Tamanho: Vazio
    Downloads: 5758

    Esse Exemplo de planilha do Aplicativo Microsoft Excel VBA(Visual Basic Application), contém macros que fazem um sistema de cadastro usando a própria folha de planilha com base de entrada de dados, e envia para uma outra planilha, (específica )


    Sub Salvando_dados()

    'envia dados da planilha1 baseado dados escritos na planilha 2
    Application.ScreenUpdating = False
    Dim sbProjeto As Integer

    Dim sbEndereco As String
    Dim sbNumTelefone As String

    Dim sbLinha As Long
    Dim sbLocaliza As Boolean

    'recuperando o número da variavel sbProjeto
    sbProjeto = Range("E3").Value

    'Recupere o novo endereço e telefone numeram a informação
    sbEndereco = Range("D5").Value
    sbNumTelefone = Range("D7").Value

    'Mova-se a Plan1 para salvar as modificações
    Sheets("Plan1").Select

    sbLocaliza = False

    sbLinha = 2

    Do While sbLocaliza = False
    'Correspondência encontrada com projeto, agora atualize o endereço e telefone numeram a informação
    If Range("A" & sbLinha).Value = sbProjeto Then
    sbLocaliza = True
    Range("C" & sbLinha).Value = sbEndereco
    Range("D" & sbLinha).Value = sbNumTelefone

    'Encontrado um número de projeto em branco (assunção de fim de lista em Plan1)
    ElseIf IsEmpty(Range("A" & sbLinha).Value) = True Then
    MsgBox ("Nenhum dado foi encontrado. As modificações não foram feitas.")
    Exit Sub
    End If

    sbLinha = sbLinha + 1
    Loop

    'selecionando a planilha Plan2
    Sheets("Plan2").Select
    Range("D5").Select

    MsgBox ("Salvo com sucesso.")
    Application.ScreenUpdating = True

    End Sub

    Sub Populate Data()
    Application.ScreenUpdating = False
    Dim sbProjeto As Integer

    Dim sbEndereco As String
    Dim sbNumTelefone As String

    Dim sbLinha As Long
    Dim sbLocaliza As Boolean

    'Guardando o valor a uma variável
    sbProjeto = Range("E3").Value

    'seleciona a planilha Plan1
    Sheets("Plan1").Select

    sbLocaliza = False

    sbLinha = 2

    Do While sbLocaliza = False
    'Correspondência encontrada com projeto, agora atualize o endereço e telefone numeram a informação em Plan2
    If Range("A" & sbLinha).Value = sbProjeto Then
    sbLocaliza = True
    sbEndereco = Range("C" & sbLinha).Value
    sbNumTelefone = Range("D" & sbLinha).Value

    Sheets("Plan2").Select
    Range("D5").Value = sbEndereco
    Range("D7").Value = sbNumTelefone

    'Encontrado um número de projeto em branco (assunção de fim de lista em Plan1)
    ElseIf IsEmpty(Range("A" & sbLinha).Value) = True Then
    MsgBox ("Nenhum dado foi encontrado para a seleção de caixa de banda.")
    Exit Sub
    End If

    sbLinha = sbLinha + 1
    Loop
    Application.ScreenUpdating = True
    End Sub

    Sub Adicionando_novos_dados()
    'Os dados de atualização em Plan1 baseado no novo cliente entraram em Plan2
    Application.ScreenUpdating = False
    Dim sbPersonalizar As String
    Dim sbProjeto As Integer
    Dim sbEndereco As String
    Dim sbNumTelefone As String

    Dim sbLinha As Long
    Dim sbLocaliza As Boolean

    'Antes de acrescentar novo cliente, assegure-se que um valor foi introduzido
    If IsEmpty(Range("D12").Value) = False Then

    'retorna nova informação
    sbPersonalizar = Range("D12").Value
    sbProjeto = Range("D14").Value
    sbEndereco = Range("D16").Value
    sbNumTelefone = Range("D18").Value

    'selecionando a Plan1 para salvar as modificações
    Sheets("Plan1").Select

    sbLocaliza = False

    sbLinha = 2

    Do While sbLocaliza = False

    'Encontrado um número de projeto em branco (assunção de fim de lista em Plan1)
    If IsEmpty(Range("A" & sbLinha).Value) = True Then
    sbLocaliza = True
    End If

    sbLinha = sbLinha + 1
    Loop

    Range("A" & sbLinha - 1).Value = sbProjeto
    Range("B" & sbLinha - 1).Value = sbPersonalizar
    Range("C" & sbLinha - 1).Value = sbEndereco
    Range("D" & sbLinha - 1).Value = sbNumTelefone

    'Reposição atrás quanto a Plan2
    Sheets("Plan2").Select

    'Update range for combo boxes
    ActiveSheet.Shapes("Drop Down 3").Select
    With Selection
    .ListFillRange = "Plan1!$B$2:$B$" & sbLinha - 1
    End With

    ActiveSheet.Shapes("Drop Down 8").Select
    With Selection
    .ListFillRange = "Plan1!$B$2:$B$" & sbLinha - 1
    End With

    'Limpando as entradas de dados
    Range("D12").Value = ""
    Range("D14").Value = ""
    Range("D16").Value = ""
    Range("D18").Value = ""

    Range("D12").Select

    MsgBox ("Novo nome adicionado com sucesso!.")
    End If
    Application.ScreenUpdating = True
    End Sub

    Sub Deletando_dados()
    Application.ScreenUpdating = False
    'Elimine dados em Plan1 do cliente escolhido em Plan2

    Dim sbProjeto As Integer

    Dim sbLinha As Long
    Dim sbLocaliza As Boolean

    'Recupere o número de número de projeto
    sbProjeto = Range("E23").Value

    'Mova-se a Plan1 para eliminar o cliente
    Sheets("Plan1").Select

    sbLocaliza = False

    sbLinha = 2

    Do While sbLocaliza = False
    'Correspondência encontrada com projeto, agora elimine a entrada de cliente
    If Range("A" & sbLinha).Value = sbProjeto Then
    sbLocaliza = True
    Rows(sbLinha & ":" & sbLinha).Select
    Selection.Delete Shift:=xlUp

    'Encontrado um número no projeto em branco (fim de lista em Plan1)
    ElseIf IsEmpty(Range("A" & sbLinha).Value) = True Then
    MsgBox ("não encontrado.")
    Exit Sub
    End If

    sbLinha = sbLinha + 1
    Loop

    'selecionando planilha Plan2
    Sheets("Plan2").Select
    Range("E23").Value = ""

    MsgBox ("Nome deletado com sucesso.")
    Application.ScreenUpdating = True
    End Sub



    Aprenda sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application) com Saberexcel


    vba cadastro atualizando cadastro userforms textboxes vba cadastro atualizando cadastro userforms textboxes

    popular!
    Adicionado em: 18/11/2010
    Modificado em: 18/11/2010
    Tamanho: Vazio
    Downloads: 3201

    Esse exemplo de procedimentos do Aplicativo Microsoft Excel VBA, contém userforms, textboxes, comboboxes, labels, para inserção de dados em um cadastro simples na folha de planilha, com opção de corrigir e salvar alguns dados via userform.
    Observe os procedimentos abaixo:

    Private Sub cbxNome_Change()
    On Error Resume Next
    'observe que usamos a WorksheetFuncionVlookup para localização do código na folha de planilha
    txtEndereco = WorksheetFunction.VLookup(cbxNome.Text, Range("A2:K50"), 2, False)
    txtCidade = WorksheetFunction.VLookup(cbxNome.Text, Range("A2:K50"), 3, False)
    txtBairro = WorksheetFunction.VLookup(cbxNome.Text, Range("A2:K50"), 4, False)
    txtEstado = WorksheetFunction.VLookup(cbxNome.Text, Range("A2:K50"), 5, False)
    txtCep = WorksheetFunction.VLookup(cbxNome.Text, Range("A2:K50"), 6, False)
    txtTelefone = WorksheetFunction.VLookup(cbxNome.Text, Range("A2:K50"), 7, False)
    txtCelular = WorksheetFunction.VLookup(cbxNome.Text, Range("A2:K50"), 8, False)
    txtCpf = WorksheetFunction.VLookup(cbxNome.Text, Range("A2:K50"), 9, False)
    txtObs = WorksheetFunction.VLookup(cbxNome.Text, Range("A2:K50"), 10, False)
    txtCodigo = WorksheetFunction.VLookup(cbxNome.Text, Range("A2:K50"), 11, False)
    End Sub

     

    Private Sub cmdAtualizar_Click()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Cadastra") 'Cadastra ("range dinamica nomeada - Expande com a digitação")

    Linha = txtCodigo + 1


    With ws

    .Cells(Linha, 2) = txtEndereco
    .Cells(Linha, 3) = txtCidade
    .Cells(Linha, 4) = txtBairro
    .Cells(Linha, 5) = txtEstado
    .Cells(Linha, 6) = txtCep
    .Cells(Linha, 7) = txtTelefone
    .Cells(Linha, 8) = txtCelular
    .Cells(Linha, 9) = txtCpf
    .Cells(Linha, 10) = txtObs
    .Cells(Linha, 1) = cbxNome.Text 'se mudar essa linha de código par ínicio só vai afetar a col(A)

    End With

    cbxNome.RowSource = "Cadastra" 'Cadastra ("range dinamica nomeada - expande com a digitação")
    cbxNome.ListIndex = txtCodigo - 1
    MsgBox ("Dados Atualizados com Sucesso!"), vbInformation, "Saberexcel - o site das macros"
    End Sub

    Private Sub cmdFechar_Click()
    Unload Me
    End Sub


    Private Sub UserForm_Initialize()
    cbxNome.RowSource = "Cadastra"
    cbxNome.ListIndex = 0
    End Sub

    Aprenda  sobre o Aplicativo  Microsoft Excel VBA - com Saberexcel



    Excel vba planiha cadastra na propria planilha Excel vba planiha cadastra na propria planilha

    popular!
    Adicionado em: 18/01/2012
    Modificado em: 18/01/2012
    Tamanho: Vazio
    Downloads: 3670

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

    'Esse macro do Aplicativo microsoft Excel VBA(Visual Basic Applicaiton), realiza um cadastro em outra folha de planilha,
    verifica a proxima linha em branco e insere os dados.
    Baixe a planilha no final da pagina. Fiquem com Deus, Expedito Marcondes.
    '- - - - - - - - - - - - - - - - - - -
    Sub cadastrar_dados()
    'verifica inconsistencia, pode fazer com mais células, caso haja célula em branco.
    If Plan1.[F6].Value <> "" _
    And Plan1.[F8].Value <> "" _
    And Plan1.[F10].Value <> "" _
    And Plan1.[F12].Value <> "" _
    And Plan1.[F14].Value <> "" _
    And Plan1.[F16].Value <> "" Then

    resposta = MsgBox("Deseja cadastrar cliente? [" & Plan1.[F6].Value & " ]", vbYesNo, "Saberexcel VBA Estudos®")
    If resposta = 6 Then
    Plan2.Range("d65000").End(xlUp).Offset(1, 0).Value = Plan1.[F6].Value
    Plan2.Range("d65000").End(xlUp).Offset(0, 1).Value = Plan1.[F8].Value
    Plan2.Range("d65000").End(xlUp).Offset(0, 2).Value = Plan1.[F10].Value
    Plan2.Range("d65000").End(xlUp).Offset(0, 3).Value = Plan1.[F12].Value
    Plan2.Range("d65000").End(xlUp).Offset(0, 4).Value = Plan1.[F14].Value
    Plan2.Range("d65000").End(xlUp).Offset(0, 5).Value = Plan1.[F16].Value

    '- limpar dados para um novo cadastro.
    Plan1.[F6].Value = ""
    Plan1.[F8].Value = ""
    Plan1.[F10].Value = ""
    Plan1.[F12].Value = ""
    Plan1.[F14].Value = ""
    Plan1.[F16].Value = ""
    Plan1.[F6].Select

    MsgBox ("Dados Cadastrados com Sucesso!"), vbInformation, " Escola Saberexcel VBA Estudos®"
    End If
    Else
    MsgBox ("Voce deverá preencher os dados primeiramente!"), vbCritical, "Escola Saberexcel VBA Estudos®"
    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.



    Excel vba  cadastro clientes propria planilha Excel vba cadastro clientes propria planilha

    popular!
    Adicionado em: 16/06/2013
    Modificado em: 16/06/2013
    Tamanho: Vazio
    Downloads: 4887

    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

    Excel planilha vba cadastro com formulario lista excel Excel planilha vba cadastro com formulario lista excel

    popular!
    Adicionado em: 30/11/2011
    Modificado em: 30/11/2011
    Tamanho: Vazio
    Downloads: 6773

    Referência do Desenvolvedor do Excel

    Worksheet.Método ShowDataForm

    Exibe o formulário de dados associado à planilha.
    Sintaxe
    expressão.ShowDataForm

    expressão Uma variável que representa um objeto Worksheet.

    Comentários

    A macro faz uma pausa enquanto você está usando o formulário de dados. Quando você fecha o formulário de dados, a macro é reiniciada na linha seguinte ao método ShowDataForm.

    Esse método executa o formulário de dados personalizado, se existir um.

    Exemplo

    Este exemplo exibe o formulário de dados de Sheet1.

    Visual Basic for Applications

    Worksheets(1).ShowDataForm

    Esses macros do Aplicativo Microsoft Excel VBA(Visual Basic Application) abre um formulário do objeto Application,
    onde voce poderá manipular os dados cadastrais de determinado banco de dados em uma planilha ms excel.

    'Esse exemplo de planilha foi retirado dos exemplos 1000 Planilhas inteligentes, para associados, há sempre uma publicação inteligente
    para os assoaciados Saberexcel, associe-se ao nosso site e veja as vantagens sobre o acesso a material didático no treinamento com macros, fórmulas e Funções Microsost Excel VBA.
    '-- - - - - - - - - - - - - - - - - - - - - - - - -
    Sub sbx_abrir_formulario_lista()
    Dim UltimaLinha As Integer
    Dim vIntervalo As Integer
    Dim vPlanilha As Worksheet

    Set vPlanilha = Worksheets("Cadastro")
    UltimaLinha = NumElementos("Cadastro", "A", 2) + 1

    For vIntervalo = 2 To UltimaLinha + 1
    Range("A" & vIntervalo & ":A" & vIntervalo).Select
    Range("A" & vIntervalo).Select
    Next
    End Sub
    '-- - - - - - - - - - - - - - - - - - - - - - - - -
    Public Function NumElementos
    (sPlanilha As String, sColuna As String, sLinha As Integer) As Integer
    Dim vIntervalo As Integer
    Dim vRegiao As String
    vIntervalo = sLinha
    vRegiao = sColuna & sLinha

    While Range(sPlanilha & "!" & vRegiao).Value <> ""
    vIntervalo = vIntervalo + 1
    vRegiao = sColuna & vIntervalo
    Wend
    NumElementos = vIntervalo - sLinha
    ActiveSheet.ShowDataForm
    End Function
    Sub sbx_autofiltro()
    Range("A6").Select
    Selection.AutoFilter
    End Sub
    '-- - - - - - - - - - - - - - - - - - - - - - - - -

    'macro retirado da coleção de 15.000 macros microsoft excel vba, fórmulas e funções.
    'aquisição no site:
    www.microsoftexcel.com.br - www.saberexcel.com
    Sub sbx_imprimir()
    Range("A2").Select
    Selection.CurrentRegion.Select
    Selection.PrintOut Copies:=1, Collate:=True
    With ActiveSheet.PageSetup
    .PrintTitleRows = ""
    .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
    .LeftHeader = ""
    .CenterHeader = ""
    .RightHeader = ""
    .LeftFooter = ""
    .CenterFooter = ""
    .RightFooter = ""
    .LeftMargin = Application.InchesToPoints(0.787401575)
    .RightMargin = Application.InchesToPoints(0.787401575)
    .TopMargin = Application.InchesToPoints(0.984251969)
    .BottomMargin = Application.InchesToPoints(0.984251969)
    .HeaderMargin = Application.InchesToPoints(0.4921259845)
    .FooterMargin = Application.InchesToPoints(0.4921259845)
    .PrintHeadings = False
    .PrintGridlines = False
    .PrintComments = xlPrintNoComments
    .PrintQuality = 360
    .CenterHorizontally = True
    .CenterVertically = False
    .Orientation = xlPortrait
    .Draft = False
    .PaperSize = xlPaperA4
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .BlackAndWhite = False
    .Zoom = 100
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .PrintErrors = xlPrintErrorsDisplayed
    End With
    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.




    Página 1 de 2

    PROMOÇÃO DIDÁTICOS SABEREXCEL



    Adquira já o Acesso Imediato
    à Area de Membros

    Compra Grantida --- Entrega Imediata

    Aprenda Excel VBA com Simplicidade de 
    códigos e Eficácia, Escrevendo Menos e
    Fazendo Mais.

    '-------------------------------------'
    Entrega Imediata:
    +  500 Video Aulas MS Excel VBA
    +  35.000 Planilhas Excel e VBA
    +  Coleção 25.000 Macros MS Excel VBA
    +  141 Planilhas Instruções Loops
    +  341 Planilhas WorksheetFunctions(VBA)
    +    04 Módulos Como Fazer Excel VBA
    +  Curso Completo MS Excel VBA
    +  Planilhas Inteligentes


    Pesquisa Google SaberExcel

    Publicidade Google

    <script type="text/javascript"><!--

    google_ad_client = "ca-pub-2317234650173689";

    /* retangulo 336 x 280 */

    google_ad_slot = "0315083363";

    google_ad_width = 336;

    google_ad_height = 280;

    //-->

    </script>

    <script type="text/javascript"

    src="http://pagead2.googlesyndication.com/pagead/show_ads.js">

    </script>

    Publicidade

    RSFirewallProtected


    Google Associados

    Depoimentos

    Adicione Saberexcel Favoritos

     
     

    Aprenda tudo sobre o Aplicativo Microsoft Excel VBA

    Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel,


       Sobre as WorksheetFunctions Funções de Planilhas que retornam valores do VBA