Página 1 de 2

Botão_Alterar

Enviado: Ter Jan 10, 2017 3:49 pm
por Hidrowapess
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

Re: Botão_Alterar

Enviado: Ter Jan 10, 2017 4:21 pm
por srobles
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 :

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
Experimente e retorne.

Abs

Re: Botão_Alterar

Enviado: Qua Jan 11, 2017 10:00 am
por Hidrowapess
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. :D

Re: Botão_Alterar

Enviado: Qua Jan 11, 2017 1:25 pm
por srobles
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

Re: Botão_Alterar

Enviado: Qui Jan 12, 2017 10:13 am
por Hidrowapess
Bom dia,

inseri o código que você me passou mais não deu muito certo, provavelmente fiz algo errado :D , bom o arquivo está ai, a senha é hidro123, nos dois casos.

Obrigada pela atenção.

Re: Botão_Alterar

Enviado: Qui Jan 12, 2017 10:52 am
por srobles
Hidrowapess,

Segue em anexo, seu modelo editado conforme solicitado.

Quaisquer dúvidas, estamos á disposição.

Abs

Re: Botão_Alterar

Enviado: Qui Jan 12, 2017 12:12 pm
por Hidrowapess
Boa tarde,

Muito obrigada , mesmo , =D.

Re: Botão_Alterar

Enviado: Qui Jan 12, 2017 1:07 pm
por srobles
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

Re: Botão_Alterar

Enviado: Qui Jan 12, 2017 2:49 pm
por Hidrowapess
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!

Re: Botão_Alterar

Enviado: Qui Jan 12, 2017 2:50 pm
por Hidrowapess
Esqueci de anexar na mensagem acima, haha :D