none
Rotina de Protect e UnProtect entra em Loop RRS feed

  • Pergunta

  • Bom dia.

    Tenho um codigo de preenchimento como mostra abaixo, e como no projeto todo, tem rotinas que preciso proteger, fiz uma subrotina para  desproteger no inicio do procedimento e no final voltar a proteger. Essa subrotina estou usando para outros procedimentos tambem, entao toda vez que faco Call Desproteger/Proteger, a subrotina protege e desprotee toda Planilha do Ficheiro, conforme mostra o codigo mais abaixo.

    O que esta acontecendo, e que quando rodo o procedimento atravez de um botao na planilha, entra em loop e so termina ....se terminar, a execucao depois de horas procesando. Para verificar a causa, depurei linha por linha com F8 e nao dava problema,mas quando voltava a rotar com o botao, entrar em looop.Comecei a cercar o problema com F9, parando a execucao em varias partes, e notei que entra em loop quando faz Call Desproteger. Mudei o codigo para so desproteger e proteger a ActiveSheet, dai sanou o problema,mas tem procedimentos que preciso buscar dados em outras planilhas, por isso fiz uma sub padrao que protege e desprotege toda planilha quando solicitado.

    A pergunta seria, porque que se proteger toda planilha ou parte, com For Each Next entra em loop?

    Desde ja agradeco um retorno.

    Tadao

    O Procedimento abaixo esta trocado todo  Call Proteger/Desproteger com Activesheet.Unprotect/Protect para poder rodar sem entrar em loop.

    Public Flag As Boolean
    '==================================================================================================
    'Procedimento para Mensagem de Prenchimento
    Sub Decidir()
    Application.ScreenUpdating = False
    Dim myRange As Range, Resp1 As Integer, Resp2 As Integer
    Flag = False
    'Call Desproteger
    ActiveSheet.Unprotect
    
    Resp1 = MsgBox("D o   Y o u    W a n t    t o    F i l l   E v e r y t h i n g ? ?" & vbCrLf & vbCrLf & _
            "Yes,For Every Calendar ---------> はい(Y)" & vbCrLf & _
            "No,just the New Records ------> いいえ(N)" & vbCrLf & _
            "Go Out ------------------------> キャンセル", vbYesNoCancel + vbQuestion + vbDefaultButton3, "ご希望処理を選択してください。")
    Select Case True
    
        Case Resp1 = vbYes 'preenche tudo
        
            Resp2 = MsgBox("Are You Sure? ....... The Data will be Irrecoverable!", _
                    vbOKCancel + vbExclamation + vbDefaultButton2)
            If Resp2 = 1 Then
                Call PreencherTudo
                Flag = True
            Else
    '            Call Proteger
                ActiveSheet.Protect DrawingObjects:=False
                Exit Sub
            End If
            
        Case Resp1 = vbNo 'preenche so os Yes
            Range("ShiHody[[Ctr]]").Select
            For Each myRange In Selection
                If myRange.Value = "Yes" Then
                    Call Preencher1
                    Flag = True
                    Exit For
                End If
            Next
            If Flag = False Then MsgBox "No data to fill out"
        Application.EnableEvents = True
        Case Resp1 = vbCancel 'cancela
    '        Call Proteger
            ActiveSheet.Protect DrawingObjects:=False
            Exit Sub
            Application.ScreenUpdating = True
        
    End Select
    
    If Flag = True Then MsgBox "........proccessed........."
    
    'Call Proteger
    ActiveSheet.Protect DrawingObjects:=False
    
    Application.ScreenUpdating = True
    End Sub
    Dim myWsh As Worksheet
    Public firstWsh As Worksheet
    '=============================================================================
    'Subrotina para desproteger as planilhas da Colecao ColPlProt
    '=============================================================================
    Sub Desproteger()
    Set firstWsh = ActiveSheet
    For Each myRange In Range("ColPlProt")
        Worksheets(myRange.Value2).Unprotect
    Next myRange
    firstWsh.Select
    End Sub
    '=============================================================================
    'Subrotina para proteger as planilhas da Colecao ColPlProt
    '=============================================================================
    Sub Proteger()
    For Each myRange In Range("ColPlProt")
        Worksheets(myRange.Value2).Protect DrawingObjects:=False
    Next myRange
    firstWsh.Select
    Set firstWhs = Nothing
    Set myWsh = Nothing
    End Sub

    terça-feira, 4 de abril de 2017 12:34

Respostas

  • Está me parecendo que esse laço infinito ocorre porque há código nas classes das planilhas, não?

    Você colocou algo em algum dos eventos Worksheet_Change / Worksheet_Activate / Worksheet_SelectionChange das planilhas?

    Experimente comentar (apagar temporariamente) todo código de todas as classes de suas planilhas e tente rodar o seu código para ver se entra em laço não esperado.


    http://www.ambienteoffice.com.br || Grupo de WhatsApp: https://chat.whatsapp.com/K1uey5Q4yJdKnsgWkVQAZG

    terça-feira, 4 de abril de 2017 18:42
    Moderador

Todas as Respostas

  • Está me parecendo que esse laço infinito ocorre porque há código nas classes das planilhas, não?

    Você colocou algo em algum dos eventos Worksheet_Change / Worksheet_Activate / Worksheet_SelectionChange das planilhas?

    Experimente comentar (apagar temporariamente) todo código de todas as classes de suas planilhas e tente rodar o seu código para ver se entra em laço não esperado.


    http://www.ambienteoffice.com.br || Grupo de WhatsApp: https://chat.whatsapp.com/K1uey5Q4yJdKnsgWkVQAZG

    terça-feira, 4 de abril de 2017 18:42
    Moderador
  • Obrigado pelo retorno e desculpe pela demora da resposta.

    Realmente tenho eventos nas planilhas qdo ativa ou desativa. Coloquei linhas de codios para desativar no inicio da rotina e ativar no final os eventos conforme codigo abaixo e funcionou beleza, obrigado.

    Dim myWsh As Worksheet
    Public firstWsh As Worksheet
    '=============================================================================
    'Subrotina para desproteger as planilhas da Colecao ColPlProt
    '=============================================================================
    Sub Desproteger()
    Application.EnableEvents = False
    Set firstWsh = ActiveSheet
    For Each myRange In Range("ColPlProt")
        Worksheets(myRange.Value2).Unprotect
    Next myRange
    firstWsh.Select
    Application.EnableEvents = True
    End Sub
    '=============================================================================
    'Subrotina para proteger as planilhas da Colecao ColPlProt
    '=============================================================================
    Sub Proteger()
    Application.EnableEvents = False
    For Each myRange In Range("ColPlProt")
        Worksheets(myRange.Value2).Protect DrawingObjects:=False
    Next myRange
    firstWsh.Select
    Set firstWhs = Nothing
    Set myWsh = Nothing
    Application.EnableEvents = True
    End Sub
    

    Para comparar com o que era antes, abri o ficheiro anterior sem modificacao, e rodei................dai estava rodando normal, nao sei porque.

    Bom, todo caso, e bom desligar e ligar os eventos quando nao precisa,nao e?

    Vou rodar para ver se da problema, e caso nao resolva volto a postar, obrigado mais uma vez.

    Tadao

    quinta-feira, 6 de abril de 2017 05:00
  • Ola Felipe, em primeiro lugar obrigado pelo suporte dispensado.

    Gostaria de deixar registrado aqui, o que ocorreu depois que modifiquei a rotina de Desproteger e Proteger em que acrescentei uma linha para desabilitar os eventos com Application.EnableEvents=False. No inicio ia bem, mas depois comecou a entrar em loop novamente e nao sabia porque. Depois de analizar com mais atencao, vi que realmente tem muitos eventos e estava como de prache, desabilitando e abilitando os eventos conforme mostra a rotinaexemplo() abaixo. No meio da rotina, quando tinha que acessar dados de outras planilhas protegidas, dava um Call Desproteger....... mas depois percebi que tinha colocado um desbilitar no inicio e abilitar no fim os eventos nas rotinas de Prodeteger e Desproteger tambem, entao o que acontecia e que na rotina mestre, onde pensei que tinha desabilitado os eventos, o Call Desproteger estava abilitando no meio da rotina...deve ser coisas de inesperiente,nao?

    Depois que coloquei tambem o Application.Calculation=xlCalculationManual, ficou mais rapido, ou seja, no meio da rotina, nao fica entrando nos loops das UDI, pois quando roda, no meio da rotina entra varias vezes nas rotinas da UDI, e quando depurava, muitas vezes deixava as rotinas da UDI como comentarios.

    Tadao

    Sub rotinaexemplo()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    'inicio da rotina
    '---------------------
    '---------------------
    '---------------------
    Call desprotege
    '---------------------
    '---------------------
    '---------------------
    '---------------------
    '----ROTINAS----------
    '---------------------
    '---------------------
    '---------------------
    '---------------------
    '---------------------
    'fim da rotina
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Call protege
    
    End Sub
    

    domingo, 23 de abril de 2017 18:52
  • Olá Antônio,

    Infelizmente, esse tipo de coisa se aprende como você aprendeu, que foi da forma mais sofrida possível.

    Esse é um padrão complicado pra caramba.


    http://www.ambienteoffice.com.br || Grupo de WhatsApp: https://chat.whatsapp.com/K1uey5Q4yJdKnsgWkVQAZG


    segunda-feira, 24 de abril de 2017 11:23
    Moderador
  • Realmente, Felipe, sao coisas que com o tempo se aprende......

    Vi as comodidades e facilidades que fornecem os eventos, e comecei a usar....mas tem que dominar bem os seus pos e contras e saber usar ,nao?

    Tadao

    quarta-feira, 26 de abril de 2017 22:31