Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Botão_Alterar
-
- Colaborador
- Mensagens: 11
- Registrado em: Ter Jan 10, 2017 3:30 pm
Botão_Alterar
boa tarde,
é a primeira vez que utilizo o VBA, fiz o meu fomulário assistindo a videos e procurando em fóruns, ele esta funcionando porém eu gostaria de inserir um botão para alterar, pois primeiro faço o cadastro do cliente e depois insiro o orçamento, mais utilizando a opção salvar ele duplica, gostaria de, quando inserir novas informações no formulário ele não duplicasse e sim alterasse.
O código está assim porém quando clico para alterar ele não altera.
Private Sub Botão_Alterar_Click()
Range("a2").Select
While ActiveCell <> ""
If Campo_Nome.Text = ActiveCell Then
ActiveCell.Offset(0, 1) = Campo_Nome.Text
ActiveCell.Offset(0, 2) = Campo_End.Text
ActiveCell.Offset(0, 3) = Campo_N.Text
ActiveCell.Offset(0, 4) = Campo_Bairro.Text
ActiveCell.Offset(0, 5) = Campo_Cidade.Text
ActiveCell.Offset(0, 6) = Campo_Telefone.Text
ActiveCell.Offset(0, 7) = Campo_NRA.Text
ActiveCell.Offset(0, 8) = Campo_Revendedor.Text
ActiveCell.Offset(0, 9) = Campo_Data.Text
ActiveCell.Offset(0, 10) = Campo_NNF.Text
ActiveCell.Offset(0, 11) = Campo_Eq.Text
ActiveCell.Offset(0, 12) = Campo_Obs.Text
ActiveCell.Offset(0, 13) = Combo_Recebido.Text
ActiveCell.Offset(0, 14) = Campo_Nome_2.Text
ActiveCell.Offset(0, 15) = Campo_Eq_2.Text
ActiveCell.Offset(0, 16) = Campo_Data_2.Text
ActiveCell.Offset(0, 17) = Campo_Orç.Text
ActiveCell.Offset(0, 18) = Campo_Cred.Text
ActiveCell.Offset(0, 19) = Campo_AV.Text
ActiveCell.Offset(0, 20) = Combo_Tec.Text
ActiveCell.Offset(0, 21) = Campo_Pronta.Text
ActiveCell.Offset(0, 22) = Campo_NAP.Text
ActiveCell.Offset(0, 23) = Campo_Retirada.Text
ActiveCell.Offset(0, 24) = Campo_Obs_1.Text
ActiveCell.Offset(0, 25) = Campo_Obs_2.Text
ActiveCell.Offset(0, 26) = Campo_Obs_3.Text
ActiveCell.Offset(0, 27) = Campo_Obs_4.Text
ActiveCell.Offset(0, 28) = Campo_Obs_5.Text
ActiveCell.Offset(0, 29) = Campo_Obs_6.Text
End If
ActiveCell.Offset(1, 0).Activate
Wend
'Mensagem de gravação
MsgBox "Alteração efetuada com sucesso "
End Sub
Private Sub Botão_Imprimir_Click()
'Para escolher impressora
Application.Dialogs(xlDialogPrinterSetup).Show
'Ativar função imprimir
Me.PrintForm
End Sub
Private Sub Botão_Salvar_Click()
'Variavel Total registro armazena a quantidade de linhas preenchidas
totalregistro = Worksheets("BancodeDados").UsedRange.Rows.Count + 1
Worksheets("BancodeDados").Select
'Começo da gravação dos Dados
Cells(totalregistro, 1) = Campo_NOS
Cells(totalregistro, 2) = Campo_Nome
Cells(totalregistro, 3) = Campo_End
Cells(totalregistro, 4) = Campo_N
Cells(totalregistro, 5) = Campo_Bairro
Cells(totalregistro, 6) = Campo_Cidade
Cells(totalregistro, 7) = Campo_Telefone
Cells(totalregistro, 8) = Campo_NRA
Cells(totalregistro, 9) = Campo_Revendedor
Cells(totalregistro, 10) = Campo_Data
Cells(totalregistro, 11) = Campo_NNF
Cells(totalregistro, 12) = Campo_Eq
Cells(totalregistro, 13) = Campo_Obs
Cells(totalregistro, 14) = Combo_Recebido
Cells(totalregistro, 15) = Campo_Nome_2
Cells(totalregistro, 16) = Campo_Eq_2
Cells(totalregistro, 17) = Campo_Data_2
Cells(totalregistro, 18) = Campo_Orç
Cells(totalregistro, 19) = Campo_Cred
Cells(totalregistro, 20) = Campo_AV
Cells(totalregistro, 21) = Combo_Tec
Cells(totalregistro, 22) = Campo_Pronta
Cells(totalregistro, 23) = Campo_NAP
Cells(totalregistro, 24) = Campo_Retirada
Cells(totalregistro, 25) = Campo_Obs_1
Cells(totalregistro, 26) = Campo_Obs_2
Cells(totalregistro, 27) = Campo_Obs_3
Cells(totalregistro, 28) = Campo_Obs_4
Cells(totalregistro, 29) = Campo_Obs_5
Cells(totalregistro, 30) = Campo_Obs_6
'Mensagem de gravação
MsgBox "O. S. Salva"
'Salvar planilha automaticamente
ActiveWorkbook.Save
End Sub
Private Sub Botão_Cancelar_Click()
Unload Nova_OS
Pag_Inicial.Show
End Sub
Private Sub Combo_Localizar_OS_Click()
totalregistro = Worksheets("bancodedados").UsedRange.Rows.Count
For i = 0 To totalregistro
If Combo_Localizar_OS.ListIndex = i Then
'Preencher as caixas
Campo_NOS = Cells(i + 2, 1)
Campo_Nome = Cells(i + 2, 2)
Campo_End = Cells(i + 2, 3)
Campo_N = Cells(i + 2, 4)
Campo_Bairro = Cells(i + 2, 5)
Campo_Cidade = Cells(i + 2, 6)
Campo_Telefone = Cells(i + 2, 7)
Campo_NRA = Cells(i + 2, 8)
Campo_Revendedor = Cells(i + 2, 9)
Campo_Data = Cells(i + 2, 10)
Campo_NNF = Cells(i + 2, 11)
Campo_Eq = Cells(i + 2, 12)
Campo_Obs = Cells(i + 2, 13)
Combo_Recebido = Cells(i + 2, 14)
Campo_Nome_2 = Cells(i + 2, 15)
Campo_Eq_2 = Cells(i + 2, 16)
Campo_Data_2 = Cells(i + 2, 17)
Campo_Orç = Cells(i + 2, 18)
Campo_Cred = Cells(i + 2, 19)
Campo_AV = Cells(i + 2, 20)
Combo_Tec = Cells(i + 2, 21)
Campo_Pronta = Cells(i + 2, 22)
Campo_NAP = Cells(i + 2, 23)
Campo_Retirada = Cells(i + 2, 24)
Campo_Obs_1 = Cells(i + 2, 25)
Campo_Obs_2 = Cells(i + 2, 26)
Campo_Obs_3 = Cells(i + 2, 27)
Campo_Obs_4 = Cells(i + 2, 28)
Campo_Obs_5 = Cells(i + 2, 29)
Campo_Obs_6 = Cells(i + 2, 30)
Exit Sub
End If
Next
End Sub
Private Sub UserForm_Initialize()
' Inserir nome do atendente
Combo_Recebido.AddItem "Bianca"
Combo_Recebido.AddItem "Henrique"
Combo_Recebido.AddItem "Jéssica"
Combo_Recebido.AddItem "Marcos"
' Inserir nome do técnico
Combo_Tec.AddItem "Adriano"
Combo_Tec.AddItem "Alex"
Combo_Tec.AddItem "João"
Combo_Tec.AddItem "Paulo"
Combo_Tec.AddItem "Uilquer"
'código para campo localizar
totaldelinhas = Worksheets("bancodedados").UsedRange.Rows.Count
Combo_Localizar_OS.RowSource = "bancodedados!b2:b" & totaldelinhas
'Contagem automatica das ordens de serviço
totalregistro = Worksheets("bancodedados").UsedRange.Rows.Count
For i = 0 To totalregistro
Plan1.Select
linha = 2
cont = i
Do Until Sheets("plan1").Cells(linha, 1) = ""
linha = linha + 1
cont = cont + 1
Loop
Campo_NOS.Text = cont
Next
End Sub
é a primeira vez que utilizo o VBA, fiz o meu fomulário assistindo a videos e procurando em fóruns, ele esta funcionando porém eu gostaria de inserir um botão para alterar, pois primeiro faço o cadastro do cliente e depois insiro o orçamento, mais utilizando a opção salvar ele duplica, gostaria de, quando inserir novas informações no formulário ele não duplicasse e sim alterasse.
O código está assim porém quando clico para alterar ele não altera.
Private Sub Botão_Alterar_Click()
Range("a2").Select
While ActiveCell <> ""
If Campo_Nome.Text = ActiveCell Then
ActiveCell.Offset(0, 1) = Campo_Nome.Text
ActiveCell.Offset(0, 2) = Campo_End.Text
ActiveCell.Offset(0, 3) = Campo_N.Text
ActiveCell.Offset(0, 4) = Campo_Bairro.Text
ActiveCell.Offset(0, 5) = Campo_Cidade.Text
ActiveCell.Offset(0, 6) = Campo_Telefone.Text
ActiveCell.Offset(0, 7) = Campo_NRA.Text
ActiveCell.Offset(0, 8) = Campo_Revendedor.Text
ActiveCell.Offset(0, 9) = Campo_Data.Text
ActiveCell.Offset(0, 10) = Campo_NNF.Text
ActiveCell.Offset(0, 11) = Campo_Eq.Text
ActiveCell.Offset(0, 12) = Campo_Obs.Text
ActiveCell.Offset(0, 13) = Combo_Recebido.Text
ActiveCell.Offset(0, 14) = Campo_Nome_2.Text
ActiveCell.Offset(0, 15) = Campo_Eq_2.Text
ActiveCell.Offset(0, 16) = Campo_Data_2.Text
ActiveCell.Offset(0, 17) = Campo_Orç.Text
ActiveCell.Offset(0, 18) = Campo_Cred.Text
ActiveCell.Offset(0, 19) = Campo_AV.Text
ActiveCell.Offset(0, 20) = Combo_Tec.Text
ActiveCell.Offset(0, 21) = Campo_Pronta.Text
ActiveCell.Offset(0, 22) = Campo_NAP.Text
ActiveCell.Offset(0, 23) = Campo_Retirada.Text
ActiveCell.Offset(0, 24) = Campo_Obs_1.Text
ActiveCell.Offset(0, 25) = Campo_Obs_2.Text
ActiveCell.Offset(0, 26) = Campo_Obs_3.Text
ActiveCell.Offset(0, 27) = Campo_Obs_4.Text
ActiveCell.Offset(0, 28) = Campo_Obs_5.Text
ActiveCell.Offset(0, 29) = Campo_Obs_6.Text
End If
ActiveCell.Offset(1, 0).Activate
Wend
'Mensagem de gravação
MsgBox "Alteração efetuada com sucesso "
End Sub
Private Sub Botão_Imprimir_Click()
'Para escolher impressora
Application.Dialogs(xlDialogPrinterSetup).Show
'Ativar função imprimir
Me.PrintForm
End Sub
Private Sub Botão_Salvar_Click()
'Variavel Total registro armazena a quantidade de linhas preenchidas
totalregistro = Worksheets("BancodeDados").UsedRange.Rows.Count + 1
Worksheets("BancodeDados").Select
'Começo da gravação dos Dados
Cells(totalregistro, 1) = Campo_NOS
Cells(totalregistro, 2) = Campo_Nome
Cells(totalregistro, 3) = Campo_End
Cells(totalregistro, 4) = Campo_N
Cells(totalregistro, 5) = Campo_Bairro
Cells(totalregistro, 6) = Campo_Cidade
Cells(totalregistro, 7) = Campo_Telefone
Cells(totalregistro, 8) = Campo_NRA
Cells(totalregistro, 9) = Campo_Revendedor
Cells(totalregistro, 10) = Campo_Data
Cells(totalregistro, 11) = Campo_NNF
Cells(totalregistro, 12) = Campo_Eq
Cells(totalregistro, 13) = Campo_Obs
Cells(totalregistro, 14) = Combo_Recebido
Cells(totalregistro, 15) = Campo_Nome_2
Cells(totalregistro, 16) = Campo_Eq_2
Cells(totalregistro, 17) = Campo_Data_2
Cells(totalregistro, 18) = Campo_Orç
Cells(totalregistro, 19) = Campo_Cred
Cells(totalregistro, 20) = Campo_AV
Cells(totalregistro, 21) = Combo_Tec
Cells(totalregistro, 22) = Campo_Pronta
Cells(totalregistro, 23) = Campo_NAP
Cells(totalregistro, 24) = Campo_Retirada
Cells(totalregistro, 25) = Campo_Obs_1
Cells(totalregistro, 26) = Campo_Obs_2
Cells(totalregistro, 27) = Campo_Obs_3
Cells(totalregistro, 28) = Campo_Obs_4
Cells(totalregistro, 29) = Campo_Obs_5
Cells(totalregistro, 30) = Campo_Obs_6
'Mensagem de gravação
MsgBox "O. S. Salva"
'Salvar planilha automaticamente
ActiveWorkbook.Save
End Sub
Private Sub Botão_Cancelar_Click()
Unload Nova_OS
Pag_Inicial.Show
End Sub
Private Sub Combo_Localizar_OS_Click()
totalregistro = Worksheets("bancodedados").UsedRange.Rows.Count
For i = 0 To totalregistro
If Combo_Localizar_OS.ListIndex = i Then
'Preencher as caixas
Campo_NOS = Cells(i + 2, 1)
Campo_Nome = Cells(i + 2, 2)
Campo_End = Cells(i + 2, 3)
Campo_N = Cells(i + 2, 4)
Campo_Bairro = Cells(i + 2, 5)
Campo_Cidade = Cells(i + 2, 6)
Campo_Telefone = Cells(i + 2, 7)
Campo_NRA = Cells(i + 2, 8)
Campo_Revendedor = Cells(i + 2, 9)
Campo_Data = Cells(i + 2, 10)
Campo_NNF = Cells(i + 2, 11)
Campo_Eq = Cells(i + 2, 12)
Campo_Obs = Cells(i + 2, 13)
Combo_Recebido = Cells(i + 2, 14)
Campo_Nome_2 = Cells(i + 2, 15)
Campo_Eq_2 = Cells(i + 2, 16)
Campo_Data_2 = Cells(i + 2, 17)
Campo_Orç = Cells(i + 2, 18)
Campo_Cred = Cells(i + 2, 19)
Campo_AV = Cells(i + 2, 20)
Combo_Tec = Cells(i + 2, 21)
Campo_Pronta = Cells(i + 2, 22)
Campo_NAP = Cells(i + 2, 23)
Campo_Retirada = Cells(i + 2, 24)
Campo_Obs_1 = Cells(i + 2, 25)
Campo_Obs_2 = Cells(i + 2, 26)
Campo_Obs_3 = Cells(i + 2, 27)
Campo_Obs_4 = Cells(i + 2, 28)
Campo_Obs_5 = Cells(i + 2, 29)
Campo_Obs_6 = Cells(i + 2, 30)
Exit Sub
End If
Next
End Sub
Private Sub UserForm_Initialize()
' Inserir nome do atendente
Combo_Recebido.AddItem "Bianca"
Combo_Recebido.AddItem "Henrique"
Combo_Recebido.AddItem "Jéssica"
Combo_Recebido.AddItem "Marcos"
' Inserir nome do técnico
Combo_Tec.AddItem "Adriano"
Combo_Tec.AddItem "Alex"
Combo_Tec.AddItem "João"
Combo_Tec.AddItem "Paulo"
Combo_Tec.AddItem "Uilquer"
'código para campo localizar
totaldelinhas = Worksheets("bancodedados").UsedRange.Rows.Count
Combo_Localizar_OS.RowSource = "bancodedados!b2:b" & totaldelinhas
'Contagem automatica das ordens de serviço
totalregistro = Worksheets("bancodedados").UsedRange.Rows.Count
For i = 0 To totalregistro
Plan1.Select
linha = 2
cont = i
Do Until Sheets("plan1").Cells(linha, 1) = ""
linha = linha + 1
cont = cont + 1
Loop
Campo_NOS.Text = cont
Next
End Sub
- Anexos
-
- PAG_2.jpg (77.15 KiB) Exibido 5591 vezes
-
- PAG_1.jpg (117.8 KiB) Exibido 5591 vezes
Re: Botão_Alterar
Hidrowapes,
Experimente o seguinte :
Com base no campo ORDEM DE SERVIÇO, vamos utilizá-lo como referência para efetuarmos a busca pelo banco de dados. Então seria algo parecido como o que segue :
Experimente e retorne.
Abs
Experimente o seguinte :
Com base no campo ORDEM DE SERVIÇO, vamos utilizá-lo como referência para efetuarmos a busca pelo banco de dados. Então seria algo parecido como o que segue :
Código: Selecionar todos
Private Sub Botão_Alterar_Click()
'Se o valor do Combo for diferente de nulo ou em branco, então
If Combo_Localizar_OS <> "" Then
'Com a aba BANCODEDADOS
With ThisWorkBook.Sheets("bancodedados")
'Ativamos a aba
.Activate
'Supondo que a coluna A guarde os valores referentes aos números de orçamento,
'fazemos a busca pelo número da ORDEM DE SERVIÇO. Altere para a coluna caso necessite
.Columns("A:A").Select
On Error Goto vErro 'Se houver erro, vá para o parágrafo vErro
Selection.Find(Combo_Localizar_OS, ActiveCell, xlValues, xlWhole, xlByRows, xlNext).Activate
vErro:
If err=91 Then 'Se o código de erro retornado for 91 (Não encontrado)
MsgBox "Ordem de serviço não cadastrada!", vbCritical, "Erro"
Exit Sub
End If
End With
'Se o valor da célula atual for igual ao do campo ORDEM DE SERVIÇO
If ActiveCell = Combo_Localizar_OS Then
'Alteramos os valores de cada célula na linha atual
Cells(ActiveCell.Row, "A")= Campo_Nome.Text
Cells(ActiveCell.Row, "B")= Campo_End.Text
Cells(ActiveCell.Row, "C") = Campo_N.Text
Cells(ActiveCell.Row, "D") = Campo_Bairro.Text
Cells(ActiveCell.Row, "E") = Campo_Cidade.Text
Cells(ActiveCell.Row, "F") = Campo_Telefone.Text
Cells(ActiveCell.Row, "G") = Campo_NRA.Text
Cells(ActiveCell.Row, "H") = Campo_Revendedor.Text
Cells(ActiveCell.Row, "I") = Campo_Data.Text
Cells(ActiveCell.Row, "J") = Campo_NNF.Text
Cells(ActiveCell.Row, "K") = Campo_Eq.Text
Cells(ActiveCell.Row, "L") = Campo_Obs.Text
Cells(ActiveCell.Row, "M") = Combo_Recebido.Text
Cells(ActiveCell.Row, "N") = Campo_Nome_2.Text
Cells(ActiveCell.Row, "O") = Campo_Eq_2.Text
Cells(ActiveCell.Row, "P") = Campo_Data_2.Text
Cells(ActiveCell.Row, "Q") = Campo_Orç.Text
Cells(ActiveCell.Row, "R") = Campo_Cred.Text
Cells(ActiveCell.Row, "S") = Campo_AV.Text
Cells(ActiveCell.Row, "T") = Combo_Tec.Text
Cells(ActiveCell.Row, "U") = Campo_Pronta.Text
Cells(ActiveCell.Row, "V") = Campo_NAP.Text
Cells(ActiveCell.Row, "W") = Campo_Retirada.Text
Cells(ActiveCell.Row, "X") = Campo_Obs_1.Text
Cells(ActiveCell.Row, "Y") = Campo_Obs_2.Text
Cells(ActiveCell.Row, "Z") = Campo_Obs_3.Text
Cells(ActiveCell.Row, "AA") = Campo_Obs_4.Text
Cells(ActiveCell.Row, "AB") = Campo_Obs_5.Text
Cells(ActiveCell.Row, "AC") = Campo_Obs_6.Text
End If
'Mensagem de gravação
MsgBox "Alteração efetuada com sucesso "
End If
End Sub
Abs
-
- Colaborador
- Mensagens: 11
- Registrado em: Ter Jan 10, 2017 3:30 pm
Re: Botão_Alterar
Bom dia,
Obrigada por responder, mas o que eu quero que o botão alterar faça, é salvar as informações novas que forem inseridas sem duplicar o cadastro.
Desculpe acho que não fiz a pergunta direito.
Obrigada por responder, mas o que eu quero que o botão alterar faça, é salvar as informações novas que forem inseridas sem duplicar o cadastro.
Desculpe acho que não fiz a pergunta direito.
Re: Botão_Alterar
Hidrowapess,
Entendi sua pergunta e é exatamente assim que o código que postei trabalha. Em teoria, não haverá duplicação dos dados, pois com base em um campo do seu formulário, pesquisamos seu valor na planilha, se o valor for localizado, mantemos a linha ativa para alterarmos os dados.
Basta apenas que o código existente no botão Alterar seja substituído por este que postei.
No código que postei, utilizei como referência o campo Ordem de serviço (Combo_Localizar_OS).
Para podermos melhor ajudar, disponibilize seu modelo para análise.
Abs
Entendi sua pergunta e é exatamente assim que o código que postei trabalha. Em teoria, não haverá duplicação dos dados, pois com base em um campo do seu formulário, pesquisamos seu valor na planilha, se o valor for localizado, mantemos a linha ativa para alterarmos os dados.
Basta apenas que o código existente no botão Alterar seja substituído por este que postei.
No código que postei, utilizei como referência o campo Ordem de serviço (Combo_Localizar_OS).
Para podermos melhor ajudar, disponibilize seu modelo para análise.
Abs
-
- Colaborador
- Mensagens: 11
- Registrado em: Ter Jan 10, 2017 3:30 pm
Re: Botão_Alterar
Bom dia,
inseri o código que você me passou mais não deu muito certo, provavelmente fiz algo errado , bom o arquivo está ai, a senha é hidro123, nos dois casos.
Obrigada pela atenção.
inseri o código que você me passou mais não deu muito certo, provavelmente fiz algo errado , bom o arquivo está ai, a senha é hidro123, nos dois casos.
Obrigada pela atenção.
- Anexos
-
- teste.rar
- (95.21 KiB) Baixado 195 vezes
Re: Botão_Alterar
Hidrowapess,
Segue em anexo, seu modelo editado conforme solicitado.
Quaisquer dúvidas, estamos á disposição.
Abs
Segue em anexo, seu modelo editado conforme solicitado.
Quaisquer dúvidas, estamos á disposição.
Abs
- Anexos
-
- teste.rar
- modelo
- (90.46 KiB) Baixado 195 vezes
-
- Colaborador
- Mensagens: 11
- Registrado em: Ter Jan 10, 2017 3:30 pm
Re: Botão_Alterar
Hidrowapess, boa tarde!
Sempre que precisar, pode contar com a ajuda do fórum, afinal, este é o intuito do mesmo.
Caso sua dúvida tenha sido sanada e seu caso tenha sido resolvido, favor edite o título do seu post com o texto [RESOLVIDO].
Abs
Sempre que precisar, pode contar com a ajuda do fórum, afinal, este é o intuito do mesmo.
Caso sua dúvida tenha sido sanada e seu caso tenha sido resolvido, favor edite o título do seu post com o texto [RESOLVIDO].
Abs
-
- Colaborador
- Mensagens: 11
- Registrado em: Ter Jan 10, 2017 3:30 pm
Re: Botão_Alterar
Boa tarde,
Utilizei o mesmo código em outro formulário, mas ele não está funcionando.
O código de acesso é o mesmo.
Valeu!
Utilizei o mesmo código em outro formulário, mas ele não está funcionando.
O código de acesso é o mesmo.
Valeu!
-
- Colaborador
- Mensagens: 11
- Registrado em: Ter Jan 10, 2017 3:30 pm
Re: Botão_Alterar
Esqueci de anexar na mensagem acima, haha
- Anexos
-
- teste1.rar
- (79.26 KiB) Baixado 183 vezes