Verifica alteração de dados em Subformulários possibilitando reversão

Na busca da solução a um colega do para alertar se algum dado foi alterado no formulário, esta função utiliza o Método GetRows

Em um módulo:

Código:

Option Compare Database
Option Explicit
Public varRsNew
Public varRsOld
Public intReg           As Integer
Public RsOldCarregado   As Boolean
Public StRstPb          As Boolean

'---------------------------------------------------------------------------------------
' Procedure     : ComparaDados
' Author        : Harysohn P. Pina (PILOTO) - Harysohn@hotmail.com
' Fórum         : Fórum Máximo Access -  http://maximoaccess.forumeiros.com/
' Date          : 30/06/2013
' Comentários   : Esta função compara os dados entre dois recordset's carregados em uma
'                 Matriz pelo método GetRows de Recordset. A função carrega dados de dois
'                 recordset's, o RstNew é carregado antes de fazer alterações no formulário
'                 enquanto que o RstOls é carregado após as alterações a ao final devolve um
'                 valor true/false indicando a alteração de dados.
'                 Use o método GetRows para copiar registros de um Recordset.GetRows retorna
'                 uma matriz bidimensional. O primeiro subscrito identifica o campo e o
'                 segundo identifica o número da linha. Por exemplo, intField representa o
'                 campo e intRecord identifica o número da linha:
'                 varRs(intField, intRecord)
'                 Para obter o primeiro valor de campo na segunda linha retornada,
'                 use código semelhante ao especificado a seguir:
'                 Campo1 = varRs(0, 1)
'                 Para obter o segundo valor de campo na primeira linha retornada,
'                 use código semelhante ao especificado a seguir:
'                 Campo2 = varRs(1, 0)
'                 A variável varRs automaticamente se tornará uma matriz bidimensional
'                 quando GetRows retornar dados.
'---------------------------------------------------------------------------------------
Function ComparaDados() As Boolean
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
10    On Error GoTo TrataErro
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      Dim X, Y, z, n
      'Carrego na variável o número de linha que foi extraído ao carregar a VarRsNew
      'é necerrário diminuir o valor em 1 pois a matriz é inicada no 0
20    z = intReg - 1
      'Nesta primeira parte faz um loop pelo número de registros (linhas) da matriz (x)
30    For X = 0 To z
          'Neste segundo loop executa um loop pelos campos da matriz (y)
40        For Y = 0 To UBound(varRsNew)
              'Comparo os dados nas duas matrizes
50            If varRsNew(Y, X) <> varRsOld(Y, X) Then
                  'seto a função para retornar o valor true
60                ComparaDados = True
70            End If
80        Next Y
90    Next X
100   Exit Function
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      'Tratamento de Erros
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exit_TrataErro:
110       DoCmd.Hourglass False
120       DoCmd.Echo True
130   Exit Function
TrataErro:
140       Select Case err.Number
              Case 0
                 'Não é um erro
150           Case Else
160             DoCmd.Hourglass False
170             DoCmd.Echo True
               'Chama a função global de tratamento de erros
180             MsgBox "Erro Gerado na função: ComparaDados" _
                      & vbNewLine & "Erro Número: " & err.Number _
                      & vbNewLine & "linha: " & Erl _
                      & vbNewLine & "Descrição: " & err.Description _
                      & vbNewLine & "Por favor contate o Administrador de Sistema.", vbCritical, err.Number & ", linha:" & Erl
190     End Select
End Function

'---------------------------------------------------------------------------------------
' Procedure     : CarregaMatrizes
' Author        : Harysohn P. Pina (PILOTO) - Harysohn@hotmail.com
' Fórum         : Fórum Máximo Access -  http://maximoaccess.forumeiros.com/
' Date          : 30/06/2013
' Comentários   : Carrega duas matrizes com valores do recordset do formulário, o primeira
'                 será carregado antes de alterar o primeiro campo clicado e a segunda após
'                 as alterações ao clicar no botão salvar
'---------------------------------------------------------------------------------------
Function CarregaMatrizes(Optional RstNew As DAO.Recordset, Optional RstOld As DAO.Recordset, _
                        Optional nCampos As Integer, Optional nRegistrosOld As Long, _
                        Optional nRegistrosNew As Long, Optional stRst As Boolean)
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
10    On Error GoTo TrataErro
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          'Carrega na matriz o recordest adiquirido pelo método GetRows
          'Esta váriável é setada como true ao clicar do botão salvar. É necessário pois evita recarregar a matriz inicial (VarRsOld)
20         If StRstPb = False Then
              'Checo a variável, o recordset de início é carregado ao alterar algum campo do formulário onde se aplica a função
              'ao ser clicado em dois campos seguidamente ela iria recarregar a matriz, o que não faria a comparação correta visto
              'que o primeiro campo clicado ja estaria com o novo dado, entao ao alterar o primeiro campo ela é setada para false encerrando
              'a função visto que a matriz já fora carregada
30            If RsOldCarregado = True Then Exit Function
40            StRstPb = True
              'passa para a Matriz todas as linhas do recordset,observe que é necessário informar a quantidade de linhas (nRegistroNew)
50            varRsOld = RstOld.GetRows(nRegistrosOld) 'passa o recordset para a variável varRsNew
60            RsOldCarregado = True
70        Else
              'passa para a Matriz todas as linhas do recordset,observe que é necessário informar a quantidade de linhas (nRegistroNew)
80            varRsNew = RstNew.GetRows(nRegistrosNew)
              'Adiciona à variável o número de registros constantes no recordset
90            intReg = nRegistrosNew
              'Chama a função que compara os dados
              'Call ComparaDados
100       End If
110   Exit Function
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      'Tratamento de Erros
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exit_TrataErro:
120       DoCmd.Hourglass False
130       DoCmd.Echo True
140   Exit Function
TrataErro:
150       Select Case err.Number
              Case 91
                 'Trata o erro 91 que ocorre quando não foi feita alteração em algum registro
160              Exit Function
170           Case Else
180             DoCmd.Hourglass False
190             DoCmd.Echo True
200             MsgBox "Erro Gerado na função: CarrgaMatrizes" _
                      & vbNewLine & "Erro Número: " & err.Number _
                      & vbNewLine & "linha: " & Erl _
                      & vbNewLine & "Descrição: " & err.Description _
                      & vbNewLine & "Por favor contate o Administrador de Sistema.", vbCritical, err.Number & ", linha:" & Erl
210   End Select
End Function

'---------------------------------------------------------------------------------------
' Procedure     : UndoSubForm
' Author        : Harysohn P. Pina (PILOTO) - Harysohn@hotmail.com
' Fórum         : Fórum Máximo Access -  http://maximoaccess.forumeiros.com/
' Date          : 01/07/2013
' Comentários   : Realiza edição no recordset para os dados da Matriz VarRsOld, esta
'                 fora carregada ao clicar de qualquer campo do subform.
'                 Faz a comparação do recordset alterado com a Matriz que fora carregada
'                 anteriormente. Em sendo diferente os dados edita e atualiza
'                 Obserte que o recordset será repassado a função na sub SalvarDados que
'                 está no subform e será o rsBase que é carregado ao click do botão salvar
'---------------------------------------------------------------------------------------
Function UndoSubForm(RstUndo As DAO.Recordset)
      'Declarações de variáveis
      Dim nReg As Long
      Dim X, Y
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
10    On Error GoTo TrataErro
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          'Movo o ponteiro para o último registro e em seguida para o primeiro
20        RstUndo.MoveLast: RstUndo.MoveFirst
          'Carrego a variável com o valor 0 e esta será incrementada a cada loop, esta variável
          'representará o número de registro do recordset, é necessário para modificar a linha da matriz
30        nReg = 0
      'executo loop no recordset
40    Do While Not RstUndo.EOF
          'comparo o primeiro campo do recordset com o primeiro campo da Matriz para caso iguais vá para
          'o procedimento que compara campo a campo
50        If RstUndo(0) = varRsOld(0, nReg) Then
              'Execito loop através do procedimento For de acordo com a quantidade de campos do recordset
              'Inicio por X = 1 para excluir da comparação o campo Código. É necess;ário diminuir em 1 para
              'dar a quantidade certa de campos a serem comparados evitando assim erro
60            For X = 1 To (RstUndo.Fields.Count - 1)
                  'Comparo os dados do registro no recordset com o registro na matriz em caso sendo diferentes
                  'significa que houve alteração
70                If RstUndo(X) <> varRsOld(X, nReg) Then
                      'Abro a edição do Recordset
80                    RstUndo.Edit
                      'Igualo os valores
90                    RstUndo(X) = varRsOld(X, nReg)
                      'Atualiza o recordset
100                   RstUndo.Update
110               End If
              'Vari para o próximo campo do recotdset e da matriz
120           Next X
130       End If
      'incremento a variável para o número de registros
140   nReg = nReg + 1
      'Movo o recordset para o próximo registro
150   RstUndo.MoveNext
160   Loop
      'Seto a variável RsOldCarregado para falso
170   RsOldCarregado = False
      'Limpo a variável intReg
180   intReg = Empty
      'Seto a variável para falso
190   StRstPb = False
      'Limpo as Matrizes
200   varRsNew = Empty
210   varRsOld = Empty
220   Exit Function
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      'Tratamento de Erros
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exit_TrataErro:
230       DoCmd.Hourglass False
240       DoCmd.Echo True
250   Exit Function
TrataErro:
260       Select Case err.Number
              Case 0
                 'Não é um erro
270           Case Else
280             DoCmd.Hourglass False
290             DoCmd.Echo True
300             MsgBox "Erro Gerado na função: UndoSubForm" _
                      & vbNewLine & "Erro Número: " & err.Number _
                      & vbNewLine & "linha: " & Erl _
                      & vbNewLine & "Descrição: " & err.Description _
                      & vbNewLine & "Por favor contate o Administrador de Sistema.", vbCritical, err.Number & ", linha:" & Erl
310     End Select
End Function

No Módulo do SubFormulário:

Código:

'---------------------------------------------------------------------------------------
' Procedure     : CarregaDados
' Author        : Harysohn P. Pina (PILOTO) - Harysohn@hotmail.com
' Fórum         : Fórum Máximo Access -  http://maximoaccess.forumeiros.com/
' Date          : 30/06/2013
' Comentários   : Sub para executar as funções do módulo para comparação de dados
'---------------------------------------------------------------------------------------
Sub CarregaDados()
Dim RsBaseOld As DAO.Recordset
If StRstPb = True Then Exit Sub
Set RsBaseOld = Me.RecordsetClone
'Checo variável, caso seja true sifnifica que o procedimento já fora executado
If RsOldCarregado = True Then Exit Sub
'Movo o Ponteieo do Recordset para o último e em seguida para o Início
RsBaseOld.MoveLast: RsBaseOld.MoveFirst
'Carrega o recordset do formulário em uma Matriz pública antes de alterar valores em campos
Call CarregaMatrizes(, RsBaseOld, , RsBaseOld.RecordCount)
RsBaseOld.Close
Set RsBaseOld = Nothing
End Sub

Nos campos do Sub-formulário invoque a sub:
Me.CarregaDados

>>> Esta chamada carrega a primeira matriz com o recordset antes da alteração


No Módulo do Formulário:

Código:

Option Compare Database
Option Explicit
Dim rsBase As DAO.Recordset

Código:

Sub CarregaDadosSalvos()
Dim StrSQL As String
If IsEmpty(varRsOld) = True Then Exit Sub
StrSQL = "SELECT * From DetalhesArtigos WHERE LND = " & Me.LN & ""
'Seta o rsbase para carregar os dados da tabela, considerando
'que na tabela já estão salvo os dados
Set rsBase = CurrentDb.OpenRecordset(StrSQL)
rsBase.MoveLast: rsBase.MoveFirst
'Carrega o recordset do formulário em uma Matriz pública ao click do botão salva
'para comparação com o recordset carregado no início
Call CarregaMatrizes(rsBase, , rsBase.Fields.Count, , rsBase.RecordCount, True)
If ComparaDados = True Then
    Me.SalvarDados
End If
rsBase.Close
Set rsBase = Nothing
End Sub


Sub SalvarDados()
Dim Msg As String
'Mensagem de questionamento para salvar os dados
Msg = MsgBox("Salvar os dados?", vbYesNo + vbQuestion, "SALVAR?")
Select Case Msg
    Case vbYes
        Me.LimpaVariáveis
        MsgBox "As alterações foram SALVAS!", vbInformation, "DADOS SALVOS"
        'Encerra a sub
        Exit Sub
    Case vbNo
        'Executa a função de retorno aos registros originais
        Call UndoSubForm(rsBase)
        'Faço um requery no subform (reconsulta)
        Me.DetalhesArtigosAlterar.Requery
        'Emite mensagem
        MsgBox "As alterações foram revertidas!", vbInformation, "DADOS REVERTIDOS"
End Select
End Sub

NoBotão Salvar no Formulário:
Me.CarregaDadosSalvos
>>> Esta chamada carrega a segunda matriz  com o recordset depois da alteração


Enjoy!!!

*****************************************************************************************************************



Repositório de Exemplos Ms Access
Sala destinada à colocação de exemplos em Ms Access (Código aberto) de e para todos os Utilizadores Cadastrados.
Não tirar duvidas nesta sala.

Agora com Restauração de arquivos deletados

Funções no Módulo para esta finalidade

Código:

'------------------------------------------------------------------------------------------
' Procedure     : UndoDeleteRecord
' Author        : Harysohn P. Pina (PILOTO) - Harysohn@hotmail.com
' Fórum         : Fórum Máximo Access -  http://maximoaccess.forumeiros.com/
' Date          : 02/07/2013
' Comentários   : Adiciona a uma matriz pública (VarRsUndo) os registros de um recordset
'                 Neste caso a variável RstDel conterá um único registro. no subform ao
'                 clique do botão "Excluir Registro", antes da exclusão este registrro
'                 será repassado a esta função que por sua vez adiciona o mesmo na Matriz
'                 Ao ser executada a primeira vez a variável nCount terá valor nulo e o
'                 códgo será direcionado à cláusula Else, assim após a primeira inserção
'                 de registros na matriz a mesma assumira o número de colunas e linha
'                 do recordset tornando-se uma matriz bidimensional, neste caso como meu
'                 recordset contém apenas 1 registros e 9 colunas a matriz terá a seguinte
'                 configuração: VarRsUndo(8,0) >> 9 colunas e 1 registro
'                 Após a primeira execução do código a variável nCountUndo será incrementada
'                 em 1 e na próxima execução correrá a primeira parte do códugo.
'                 Neste ponto eu crio uma Matriz temporária para conter os valores do registro
'                 no recodset e redimensiono a matriz VarRsUndo para lhe aumentar 1 registro
'                 Observe a instrução que utilizo para isso:
'                 ________________________________________________________________
'                 >>>>> ReDim Preseve VarRsUndo(NumeroColunas,NumeroRegistro) <<<<
'                 ================================================================
'                 A instrução ReDim Redimensiona a Matriz em número de colunas e linhas e
'                 a instrução Preserve mantém os valores anteriores que estão na matriz
'                 seguidamente realizo um loop na Matriz temporária em suas colunas e a
'                 cada loop vou adicionando os valores na respectiva coluna e na nova linha
'                 inserida no comando ReDim
'------------------------------------------------------------------------------------------
Function UndoDeleteRecord(RstDel As DAO.Recordset)
If nCountUndo > 0 Then
    Dim VarRsUndoTMP
    Dim X As Integer
    'Redimensiona a matriz apra aumentar uma linha preservando os registros anteriores
    ReDim Preserve VarRsUndo(0 To 9, nCountUndo)
    'Adiciono a matriz VarRsUndoTEMP os valores contidos no recordset
    VarRsUndoTMP = RstDel.GetRows
  'Faço um loop pelos campo da matriz temporária, observe que especifico o loop iniciando do 0 para o maior
  'valor de coluna, a instrução Ubound(Matriz,1 ou 2) retorna a maior coluna ou linha(2)
  For X = 0 To UBound(VarRsUndoTMP, 1)
      'Adicio à Matriz VarRsUndo os respectivos valores da matriz temporária
      VarRsUndo(X, nCountUndo) = VarRsUndoTMP(X, 0)
  'Vai para a próxima coluna
  Next X
  'Incremento a variável
  nCountUndo = nCountUndo + 1
Else
    'Adiciono à variável o valor 0
    nCountUndo = 0
    'Adiciono a primeira coleção de campos no registro de número 0 na matriz
    VarRsUndo = RstDel.GetRows
    'Incremento a variável em 1
    nCountUndo = nCountUndo + 1
End If
'Seto a variável para true para que no sub form execute a função
Restaura = True
End Function

'---------------------------------------------------------------------------------------
' Procedure     : RestauraRegDel
' Author        : Harysohn P. Pina (PILOTO) - Harysohn@hotmail.com
' Fórum         : Fórum Máximo Access -  http://maximoaccess.forumeiros.com/
' Date          : 03/07/2013
' Comentários   : Restaura os arquivos gravados na Matriz VarRsUndo adicionando regostros
'                 no recordset especificando a quantidade de registros restaurados
'---------------------------------------------------------------------------------------
Function RestauraRegDel(RstRest As DAO.Recordset)
Dim X, Y
Dim nCount As Integer
'Executo loop na matriz em seus registros
For Y = 0 To UBound(VarRsUndo, 2)
        'Crio um novo registro
        RstRest.AddNew
        'Faço loop nos campos da matriz, observe que começo em 1 pois o campo 0 é o da chave primária e não
        'poder ser aplicado na tabela, da mesma forma inicio a edição do recordset no campo x = 1
        For X = 1 To UBound(VarRsUndo, 1)
            'Adicio ao Recordset VarRsUndo os respectivos valores de coluna e linha da matriz temporária
            RstRest(X) = Nz(VarRsUndo(X, Y), "")
        'Vai para a próxima coluna
        Next X
'Incremento a variável em 1
nCount = nCount + 1
'Atualizo o Recordset
RstRest.Update
'Movo para a próxima linha da matriz
Next Y
MsgBox "Foram restaurados " & nCount & " Registros", vbInformation, "RESTAURAÇÃO EFETUADA"
'Redimensiono a matriz a seus valores originais
ReDim VarRsUndo(0, 0)
nCountUndo = Empty
'Seto a variável RsOldCarregado para falso
RsOldCarregado = False
'Limpo a variável intReg
intReg = Empty
'Seto a variável para falso
StRstPb = False
'Limpo as Matrizes
varRsNew = Empty
VarRsUndo = Empty
VarRsUndoTMP = Empty
varRsOld = Empty
End Function


Atualizado com tratamento de erros.



1 - Este exemplo foi testado por mim para Exclusão de um ou mais registros, e restauração dos mesmos

2 - Reversão de alterações feitas nos campos

3 - Aviso de registro novo




Caso percebam alguma discrepância avisem-me via MP para que possa ser corrigido. Até então nos testes não percebi mais erros.

Cumprimentos.

Nossa Piloto, coisa de gente grande em! Estive vendo os códigos
e percebi o quanto podemos ir no Access quando se conhece VBA
e suas bibliotecas...

Cara você está de parabéns, cada vez mais disseminando o conhecimento adiquirido! Muito bom mesmo!! Será de grande
valia para todos nós!

Um dia chego lá também!