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 [ Descendente ]

    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


    Página 2 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