Detalhes de vba cadastro cadastrando na propria planilha

PropriedadeValor
Nome:vba cadastro cadastrando na propria planilha
Descricao:

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


Nome do arquivo:vba cadastro cadastrando na propria planilha.zip
Tamanho: Vazio
Tipo:zip (Tipo de Mime: application/zip)
Autor:SaberExcel
Criado em: 18/11/2010 20:12
Visitas:Todos
Responsavel:Editor
Acessos:5758 Acessos
Atualizado em: 18/11/2010 20:14
Site: