Olá!
Neste post trago uma solução que adequamos à uma situação de segurança solicitado por um cliente.
A planilha de modelo aqui, após habilitação da macro, impede o usuário de trocar a senha de abertura da planilha. “Após habilitação da macro”. A aplicação desse código foi vinculado a outras questões de segurança que impediam o usuário de ter acesso ao menu antes de habilitar as macros.
Senha de abertura: teste
Segue o modelo:
Segue aqui o código utilizado:
Option Explicit
‘ Senha que será reescrita
Private Const C_WORKBOOK_OPEN_PASSWORD As String = “teste”
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
‘
‘ Este evento adiciona uma senha de abertura da pasta de trabalho.
‘ Caso o usuário mude a senha, esta será reescrita para a senha definida acima.
‘ Para que esta função funcione deve-se estar com as macros habilitadas.
‘ Sugerimos que faça um bloqueio de acesso via xml para forçar o usuário a habtilitar
‘ as macros na abertura para rodar seu projeto.
Dim fname As Variant
Dim bSaved As Boolean
Dim shtsSelected As Sheets
Dim objActiveSheet As Object
On Error GoTo ErrorHandler
‘ Adiciona senha de abertura
Me.Password = C_WORKBOOK_OPEN_PASSWORD
‘ Salva a planilha e a pasta ativa
Set objActiveSheet = ActiveSheet
Set shtsSelected = ThisWorkbook.Windows(1).SelectedSheets
If SaveAsUI Then ‘Usuário está tentando salvar como…
Cancel = True ‘Cancela a ação do usuário
‘ Busca o caminho do arquivo
fname = Application.GetSaveAsFilename( _
fileFilter:=”Excel Marcro-Enabled Workbook (*.xlsm),*.xlsm”)
If fname = False Then GoTo ExitPoint ‘Fecha se o usuário cancelar
‘ Salva a Pasta de Trabalho
Application.EnableEvents = False
ThisWorkbook.SaveAs Filename:=fname, FileFormat:=52
’52 = xlOpenXMLWorkbookMacroEnabled = xlsm (Excel 2007+)
Application.EnableEvents = True
Else
‘ Salva a Pasta de Trabalho
Application.EnableEvents = False
ThisWorkbook.Save
Application.EnableEvents = True
End If
ExitPoint:
bSaved = ThisWorkbook.Saved
‘ Seleciona a planilha ativa salva
shtsSelected.Select
objActiveSheet.Activate
If bSaved Then ThisWorkbook.Saved = True
Exit Sub
ErrorHandler:
Application.EnableEvents = True
MsgBox “Erro durante salvamento – ” & Err.Number, vbCritical, “Error”
End Sub