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
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
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
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.
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.
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
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
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.