Pedir confirmação a...
 
Notifications
Clear all

Pedir confirmação antes de deletar

7 Posts
2 Usuários
0 Reactions
1,204 Visualizações
(@sforni)
Posts: 6
Active Member
Topic starter
 

Bom dia a todos!
Estou tendo alguns problemas com perda de dados quando algum usuário deleta a célula acidentalmente.
Gostaria de um codigo que pedisse confirmação via msgbox ao deletar uma celula.

 
Postado : 11/01/2016 8:54 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

De uma olhada no link abaixo se ajuda :

VBA Excel pedir autorização para alterar dados de uma célula
http://www.tomasvasquez.com.br/forum/vi ... lula#p5710

Leia sobre este recurso em :
http://blog.npibrasil.com/index.php/com ... -no-excel/

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 11/01/2016 9:03 am
(@sforni)
Posts: 6
Active Member
Topic starter
 

Boa tarde Mauro!
Obrigado por se prontificar em me ajudar.
Mauro o código em questão resolveria meu problema sim, porem como faço para mudar o intervalo?
Gostaria que ele abrangesse da "A3" até "AC148"

 
Postado : 11/01/2016 12:48 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde Mauro!
Obrigado por se prontificar em me ajudar.
Mauro o código em questão resolveria meu problema sim, porem como faço para mudar o intervalo?
Gostaria que ele abrangesse da "A3" até "AC148"

Siga os passos do link que eu passei no tópico anterior quanto ao Range (celulas) que pretende proteger ( http://blog.npibrasil.com/index.php/com ... -no-excel/), no seu caso o Range A3:AC148, e defina a senha.
Feito isto, coloque as instruções abaixo na aba em que definiu os ranges, clique com o botão direito na aba e selecione "Exibir Código", copie as rotinas e cole, salve e faça os testes.

Observe que na rotina "ApagaOuAlteraSenha" onde está definida a Senha, você precisa alterar de acordo com a que voce definiu.

Private Sub Worksheet_Change(ByVal Target As Range)
    Call ApagaOuAlteraSenha
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    If Not Application.Intersect(Target, Range("A3:AC148")) Is Nothing Then
        If Target.Value = "" Then
            ActiveSheet.Unprotect
        End If
    Else
        Call ApagaOuAlteraSenha
    End If

End Sub

Sub ApagaOuAlteraSenha()
Dim ws As Worksheet

Set ws = Application.ActiveSheet
    
    ws.Unprotect

    ' Apaga somente a Senha.
    ws.Protection.AllowEditRanges.Item(1).ChangePassword _
        Password:="SuaSenha" 'Altere para a senha que definiu

   ' MsgBox "A Senha para essa celula foi alterada."

    ws.Protect
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 11/01/2016 9:29 pm
(@sforni)
Posts: 6
Active Member
Topic starter
 

Boa tarde Mauro!
Fiz os testes só que encontrei o seguinte problema:
Se bem entendi o código ele teria que fazer o seguinte: Ao clicar em uma celula vazia ele desprotege o intervalo, Ao clicar em um Celula com dados ele protege o intervalo.
Contudo ao sair de uma célula vazia e clicar em uma com dados ele não realiza o bloqueio permitindo a alteração dos dados.

 
Postado : 12/01/2016 11:59 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!!

Essa postagem não te ajuda?
viewtopic.php?t=5487&p=29083
Veja o código que eu postei.

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 12/01/2016 12:04 pm
(@sforni)
Posts: 6
Active Member
Topic starter
 

Boa tarde Alexandre!
Seu codigo resolveria meu problema sim, contudo como vou inseri-lo no codigo abaixo?

Private Sub Worksheet_Change(ByVal Alvo As Range)
Dim limite_maximo As Integer
limite_maximo = 300 ' altere aqui para limitar a última linha

If Alvo.Column = 28 And Alvo.Row >= 2 And Alvo.Row <= limite_maximo Then
' o if acima garante que a célula modificada está dentro a2:a100
' desliga captura do evento change

Dim resultado As VbMsgBoxResult
resultado = MsgBox("Confirma alteração da data?", vbYesNo)
If resultado = vbYes Then

Application.EnableEvents = False
' muda a célula C da linha correspondente
Alvo.Offset(0, -1).Value = Date
' religa a captura de eventos
Application.EnableEvents = True
End If

Else

End If

 
Postado : 12/01/2016 2:04 pm