MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


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

    avatar
    Convidado
    Convidado


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

    Mensagem  Convidado 1/7/2013, 01:16

    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.


    Última edição por PILOTO em 1/7/2013, 19:32, editado 4 vez(es) (Motivo da edição : Atualização do Códipo permitindo Undo)
    avatar
    Convidado
    Convidado


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

    Mensagem  Convidado 3/7/2013, 22:48

    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
    avatar
    Convidado
    Convidado


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

    Mensagem  Convidado 4/7/2013, 01:32

    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.


    Última edição por PILOTO em 4/7/2013, 04:55, editado 1 vez(es) (Motivo da edição : Atualizado em 04-07-2013 às 00:55 horas)
    Marcelo David
    Marcelo David
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3857
    Registrado : 21/04/2011

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

    Mensagem  Marcelo David 5/7/2013, 13:06

    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! cheers 


    .................................................................................
    Aprenda como criar formulário desacoplado.
    Conheça meu canal no Youtube e se inscreva.
    Verifica alteração de dados em Subformulários possibilitando reversão Marcel11

    Conteúdo patrocinado


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

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 28/3/2024, 15:47