Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Registrar alteração

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
adhuters
Colaborador
Colaborador
Mensagens: 11
Registrado em: Dom Jan 07, 2018 12:53 pm

Registrar alteração

Mensagem por adhuters »

Pessoal, Boa noite!

Preciso registrar as alterações realizadas na planilha. No código abaixo, ele traz a data, a célula, o usuário e qual é o atual valor da célula alterada, porém, preciso que ele informe também a informação anterior que estava na celula.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim wsHist As Worksheet, Rng As Range
Set wsHist = Sheets("Log")
If Sh Is wsHist Then Exit Sub
Set Rng = wsHist.Range("A" & Rows.Count).End(xlUp).Offset(1)
With Rng
.Value = Now
.Offset(, 1) = Sh.Name
.Offset(, 2) = Target.Address
.Offset(, 4) = VBA.Environ("username")
If Target.Cells.Count > 1 Then
.Offset(, 3) = "Valores Alterados"
Else
.Offset(, 3) = Target.FORMULA
End If
End With
End Sub

Agradeço pela ajuda!


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
muca
Acabou de chegar
Acabou de chegar
Mensagens: 5
Registrado em: Dom Fev 05, 2017 4:58 pm
Localização: São José dos Campos(SP)
Contato:

Re: Registrar alteração

Mensagem por muca »

Veja se ajuda:

EstaPastaDeTrabalho:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim wsHist As Worksheet, Rng As Range
Set wsHist = Sheets("Log")
If Sh Is wsHist Then Exit Sub
Set Rng = wsHist.Range("A" & Rows.Count).End(xlUp).Offset(1)
With Rng
.Value = Now
.Offset(, 1) = Sh.Name
.Offset(, 2) = Target.Address
.Offset(, 5) = Application.UserName 'VBA.Environ("username")
If Target.Cells.Count > 1 Then
.Offset(, 4) = "Valores Alterados" 'Coluna que informa alteração digitada, no caso coluna E
Else
.Offset(, 4) = Target.Formula
End If
End With
End Sub

Na Planilha com dados:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lUltimaLinhaAtiva As Long
lUltimaLinhaAtiva = Planilha1.Cells(Rows.Count, "A").End(xlUp).Row + 1
Planilha1.Cells(lUltimaLinhaAtiva, 4).Value = Target.Value '(lUltimaLinhaAtiva, 4) Coluna com informação antes da alteração, no caso coluna D
End Sub


Responder