Notifications
Clear all

Ocultar e proteger em VBA

8 Posts
2 Usuários
0 Reactions
4,303 Visualizações
(@cadeca)
Posts: 6
Active Member
Topic starter
 

Bom dia amigos! Acabei de chegar a este forum.
Tenho em uma série de planilhas que são protegidas e desprotegidas com um código VBA. Quando fizemos a proteção pela primeira vez, desmarcamos na caixa onde colocamos a senha, a opção "Selecionar células bloqueadas", justamente para proteger o conteudo daquelas células. Até aí tudo bem. Toda vez que ativamos esse código (que protege e desprotege) aquela condição de não selecionar células bloqueadas é preservada.
Por necessidade de ocultar linhas com determinada condição, conseguimos um outro código (segue abaixo) que DESPROTEGE, OCULTA AS LINHAS e volta a PROTEGER.
Aí está o nosso problema: Depois de usar esse segundo código. que na verdade faz o que necessitamos, aquela opção de NÃO SELECIONAR CÉLULAS BLOQUEADAS volta a ficar marcada e consequentemente, aquelas células antes protegidas podem ser selecionadas. Tem como resolver isso? Agradeço antecipadamente qualquer ajuda.

Private Sub CommandButton1_Click()
Ocultar
End Sub
Sub Ocultar()
'Desprotege a planilha utilizando o password "exemplo"
ActiveSheet.Unprotect "exemplo"
Dim i As Integer
For i = 1 To 246
If Range("A" & i).Value = "" Then
Rows(i & ":" & i).Select
Selection.EntireRow.Hidden = True
Else
End If
Next i
'Protege novamente a planilha
ActiveSheet.Protect "exemplo"
End Sub
Sub Mostrar()
'Desprotege a planilha utilizando o password "exemplo"
ActiveSheet.Unprotect "exemplo"
Cells.Select
Selection.EntireRow.Hidden = False
Range("A1").Select
'Protege novamente a planilha
ActiveSheet.Protect "exemplo"
End Sub
 
Postado : 03/05/2012 9:30 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Seja bem vindo!!

Vou mover seu tópico para um lugar apropriado.

Use também pesquisa do fórum

Att

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

 
Postado : 03/05/2012 10:14 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Experimente:
Substitua a linha ActiveSheet.Protect......

Por: ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="exemplo"
ActiveSheet.EnableSelection = xlUnlockedCells

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

 
Postado : 03/05/2012 1:26 pm
(@cadeca)
Posts: 6
Active Member
Topic starter
 

Obrigado pela resposta, Reinaldo.
Devo avisá-lo que meu conhecimento sobre VBA aproxima-se do "zero absoluto". mesmo assim, ao aplicar sua sugestão, percebi que o problema não ocorre no código acima, utilizado apenas quando necessário ocultar linhas.
Como eu havia informado, tenho também um código que protege e desprotege todas as planilhas da pasta, que apresento abaixo:

Sub Proteger()
        Dim Planilha As Worksheet
        Dim Senha As String
       
        Senha = InputBox("Digite a Senha:", "Senha de Proteção")
        For Each Planilha In Worksheets
            Planilha.Protect Senha
            Next
    End Sub

    Sub Desproteger()
        Dim Planilha As Worksheet
        Dim Senha As String
       
        Senha = InputBox("Digite a Senha:", "Senha de Proteção")
        For Each Planilha In Worksheets
            Planilha.Unprotect Senha
        Next
    End Sub

Então empíricamente, eu tentei aproveitar a sua resposta e adaptei, ficando assim:

Sub Proteger()
        Dim Planilha As Worksheet
        Dim Senha As String
       
        Senha = InputBox("Digite a Senha:", "Senha de Proteção")
        For Each Planilha In Worksheets
            Planilha.Protect Senha
            ActiveSheet.EnableSelection = xlUnlockedCells
        Next
    End Sub

    Sub Desproteger()
        Dim Planilha As Worksheet
        Dim Senha As String
       
        Senha = InputBox("Digite a Senha:", "Senha de Proteção")
        For Each Planilha In Worksheets
            Planilha.Unprotect Senha
        Next
    End Sub

Como eu pressenti, esta solução apenas impediu a seleção em células bloqueadas da planilha onde fica o botão que ativa a macro. Sinto que falta pouco. Como ajustá-la para que a solução se estenda a todas as planilhas da pasta??
Antecipadamente agradeço a atenção, e parabenizo a todos os colaboradores pelo grande trabalho que vocês prestam.
Forte abraço.

 
Postado : 06/05/2012 5:20 am
(@cadeca)
Posts: 6
Active Member
Topic starter
 

Desculpe, mas gostaria de falar de mais uma situação a respeito do código acima:
No momento de impostar a senha para ativação ou desativação, a mesma fica visível na janela. Como fazer para que ao invés da senha, apareçam pontos ou asteriscos, como é comum?
Mais uma vez, muito obrigado.

 
Postado : 06/05/2012 5:29 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Pela InputBox não uma boa opção, apesar de outros recursos poder torna isso possível.

Use um formulário!!

Att

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

 
Postado : 06/05/2012 5:40 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Cadeca, se entendi, faça da seguinte forma :

Mascara "Asteriscos no InputBox" :
http://www.tomasvasquez.com.br/blog/mic ... cara-senha
Crie um Novo Módulo, e no mesmo cole as rotinas abaixo :

Option Explicit

'////////////////////////////////////////////////////////////////////
'Password masked inputbox
'Allows you to hide characters entered in a VBA Inputbox.
'
'Code written by Daniel Klann
'http://www.danielklann.com/
'March 2003

'// Kindly permitted to be amended
'// Amended by Ivan F Moala
'// http://www.xcelfiles.com
'// April 2003
'// Works for Xl2000+ due the AddressOf Operator
'////////////////////////////////////////////////////////////////////

'API functions to be used
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
                                                      ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
 
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" ( _
                                         ByVal lpModuleName As String) As Long
 
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" ( _
                                          ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) _
                                          As Long
 
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
 
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" ( _
                                            ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, _
                                            ByVal lParam As Long) As Long
 
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, _
                                                                          ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
 
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
 
'Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0
 
Private hHook As Long
 
Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
    Dim RetVal
    Dim strClassName As String, lngBuffer As Long
 
    If lngCode < HC_ACTION Then
        NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
        Exit Function
    End If
 
    strClassName = String$(256, " ")
    lngBuffer = 255
 
    If lngCode = HCBT_ACTIVATE Then    'A window has been activated
        RetVal = GetClassName(wParam, strClassName, lngBuffer)
        If Left$(strClassName, RetVal) = "#32770" Then    'Class name of the Inputbox
            'This changes the edit control so that it display the password character *.
            'You can change the Asc("*") as you please.
            SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
        End If
    End If
 
    'This line will ensure that any other hooks that may be in place are
    'called correctly.
    CallNextHookEx hHook, lngCode, wParam, lParam
 
End Function
 
'// Make it public = avail to ALL Modules
'// Lets simulate the VBA Input Function
Public Function InputBoxDK(Prompt As String, Optional Title As String, Optional Default As String, _
                           Optional Xpos As Long, Optional Ypos As Long, Optional Helpfile As String, _
                           Optional Context As Long) As String
 
    Dim lngModHwnd As Long, lngThreadID As Long
 
    '// Lets handle any Errors JIC! due to HookProc> App hang!
    On Error GoTo ExitProperly
    lngThreadID = GetCurrentThreadId
    lngModHwnd = GetModuleHandle(vbNullString)
 
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
    If Xpos Then
        InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context)
    Else
        InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile, Context)
    End If
 
ExitProperly:
    UnhookWindowsHookEx hHook
 
End Function

Como postou 4 rotinas, sendo nomes repetidos, acredito que o que pretende são para as segundas, mas pode adaptar para as outras, lembrando para que a mesma tenha efeito para todas as Abas, trocamos a instrução "ActiveSheet" pela variável que foi criada representando as Worksheet, ou seja "Planilha" :
Fiz a adaptação somente em duas rotinas, mas é bem simples a adaptação para as outras :

    Sub Proteger()
            Dim Planilha As Worksheet
            Dim Senha As String
           
            'Converte os caracteres em Asteriscos
            Senha = InputBoxDK("Digite a Senha:", "Senha de Proteção")

            For Each Planilha In Worksheets
                Planilha.Protect Senha
                Planilha.EnableSelection = xlUnlockedCells
            Next
        End Sub

        Sub Desproteger()
            Dim Planilha As Worksheet
            Dim Senha As String
            
            'Converte os caracteres em Asteriscos
            Senha = InputBoxDK("Digite a Senha:", "Senha de Proteção")
          
            For Each Planilha In Worksheets
                Planilha.Unprotect Senha
            Next
        End Sub

Faça os testes e veja se é isto o que quer.

[]s

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

 
Postado : 06/05/2012 8:50 am
(@cadeca)
Posts: 6
Active Member
Topic starter
 

Estou bastante agradecido pela ajuda que obtive para conseguir a máscara "Asteriscos no ImputBox". Ficou perfeito.
Acontece que o outro problema eu ainda não resolvi. Temo até que o fato de eu marcar o tópico como resolvido, inviabilize o esclarecimento da minha duvida nesse mesmo tópico. Mesmo assim, vou relatar:
Eu havia dito nas mensagens acima que as pastas de trabalho (são três) protegidas por senha através de código VBA e com a opção de NÃO SELECIONAR CÉLULAS BLOQUEADAS não preservavam essa condição depois que a pasta fosse fechada (salva) e posteriormente reaberta. Para ficar mais claro: Eu protegia // a condição de não seleção das células bloqueadas era mantida // eu fechava a pasta de trabalho salvando // ao reabrir a pasta, automaticamente as células que antes não podiam ser selecionadas, passavam a ser. Isso fez com que eu acreditasse que tal fato se devesse a alguma deficiência no código, me levando a abrir esse tópico no Fórum. Ao aplicar as sugestões gentilmente apresentadas, vi que o problema continuava e então pude perceber com meu pequeníssimo conhecimento de Excel, que o problema não tem nada a ver com os códigos existentes.
Pelo que pude observar, já que venho trabalhando e aprimorando essas pastas há bastante tempo, esse problema (das células bloqueadas poderem ser selecionadas) começaram a aparecer de certo tempo para cá, talvez depois do PC novo que venho usando. Aceito sugestões para resolver isso.
Desculpe a extensão do texto. Procurei ser claro visto que nem sempre é fácil expressar-se de forma que possa ser perfeitamente entendido.
Obrigado mais uma vez.

 
Postado : 07/05/2012 7:51 pm