Acesso Livre - Registrados (REGISTRE-SE!)
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
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
Adicionado em: | 16/10/2011 |
Modificado em: | 16/10/2011 |
Tamanho: | Vazio |
Downloads: | 39425 |
Saberexcel - o site de quem precisa aprender sobre macros Microsoft Excel VBA.
Esses exemplos de macros e procedimentos do Aplicativo Microsoft Excel VBA, efetua um cadastro muito simples para um nível de iniciantes, na folha de planiha atraves de objeto Formulário, textbox, labels, com sistema de busca simples, também obtido atraves de GM(Gravação de Macros) para a busca do ítem desejado. Na lição_1 do nosso CURSO COMPLETO MICROSOFT EXCEL VBA, falamos muito sobre como dominar esse conhecimento com Gravador de Macros, porque achamos muito importante para quem esta iniciando com desenvolvimento e programação de planilhas automatizadas. esse Exemplo de Planilha está em nosso DVD - 14.000 Planilhas Excel VBA - Treinamento e desenvovimento a partir de exemplos prontos. contém excelentes exemplos. Fiquem com Deus, Expedito Marcondes.
'--------------------------------------'
Private Sub BTN_Cadastrar_Click()
Dim NR As Long
'VERIFICA SE OS DADOS FORAM DIGITADOS (TIPO verifica inconsistência)
If TXT_TELEFONE.Text = "" Then
MsgBox "Digite o telefone para cadastro.", vbinformtaion,"Saberexcel VBA Estudos®"
TXT_TELEFONE.SetFocus
Exit Sub
ElseIf TXT_NOME.Text = "" Then
MsgBox "Digite o nome do dono do telefone.", vbinformtaion,"Saberexcel VBA Estudos®"
TXT_NOME.SetFocus
Exit Sub
End If
Sheets("AGENDA").Select
Range("A6").End(xlDown).Select
NR = ActiveCell.Row
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveCell.Offset(0, 0).Value = lbNUM.Caption
ActiveCell.Offset(0, 1).Value = TXT_TELEFONE.Text
ActiveCell.Offset(0, 2).Value = TXT_NOME.Text
ActiveCell.Offset(0, 3).Value = TXT_ENDERECO.Text
ActiveCell.Offset(0, 4).Value = TXT_CIDADE.Text
ActiveCell.Offset(0, 5).Value = TXT_TELEFONE.Text
TXT_TELEFONE.Text = ""
TXT_NOME.Text = ""
TXT_ENDERECO.Text = ""
TXT_CIDADE.Text = ""
TXT_TELEFONE.SetFocus
Me.lbNUM = Sheets("AGENDA").Range("a65536").End(xlUp).Row + 0
End Sub
Private Sub BTN_Sair_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Me.lbNUM = Sheets("AGENDA").Range("a65536").End(xlUp).Row - 4
End Sub
Macro para gusca busca a ser efetuada pelos números dos telefones
Sub PESQUISA()
Cells.Find(What:=Plan1.Cells(6, 2), _
After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
End Sub
'- formula Formatação condicional .....
=SE($B6=$K$2;VERDADEIRO;FALSO)
fórmula usada.(k4) abaixo (Para busca de dados) via fórmula.
=SE(K2="";"";ÍNDICE($C$6:$C$44;CORRESP(K2;$B$6:$B$44;0);1))
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.
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, |
'Esse exemplo de planilha foi retirado dos exemplos 1000 Planilhas inteligentes, para associados, há sempre uma publicação inteligente
|
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.
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.
Adquira já o Acesso Imediato
à Area de Membros
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
<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>
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