Workbook encryption with macro.. help!

You could create code in the Workbook_BeforeSave event in the ThisWorkbook module:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Me.Password = "Help123"
End Sub

Even if the user changes or disables the password, it will be restored when the workbook is saved.

But if the user opens the workbook with Shift held down, automatic macros will be disabled, so the above code will not run. In other words, a knowledgeable user can easily bypass your security.

In the ThisWorkbook module, enter the following code:

Option Explicit

Private Const C_WORKBOOK_OPEN_PASSWORD As String = "Help123"

Private Sub Workbook_Open()

' Unhide the sheets. This Workbook_Open event will run only if macros are enabled. If macros are

' not enabled, this code will not run and only the introduction sheet will be visible.

    Call UnHideSheets

    ThisWorkbook.Saved = True

End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

' This BeforeSave event adds a password to re-open the workbook.  If the user

' changes the password via File > Info > Protect Workbook that change will be

' overwritten with the password hardcoded above.  The workbook can only be

' saved as a Macro Enabled Workbook (.xlsm).

'

' By preventing access to the normal SaveAs dialog, users are unable to enter

' a different password for re-opening via Tools > General Options in the SaveAs

' dialog.

'

' Before the Workbook is saved, all sheets are hidden and the Intro sheet is

' un-hidden.  The Intro sheet should contain text for the user indicating that

' the workbook should be opened with macros enabled along with instructions on

' how to enable macros.

'

' Access to the VBAProject should be restricted by a different password via:

' VBE > Tools > VBAProject Properties > Protection > Lock Project for viewing.

'

' This Workbook_BeforeSave will run only if macros are enabled

' (and if events are in the VBE!).

'
    Dim fname As Variant

    Dim bSaved As Boolean, bOldStatusBar As Boolean

   Dim shtsSelected As Sheets

    Dim objActiveSheet As Object

    ' Display message on statusbar and prevent screen updating:

    bOldStatusBar = Application.DisplayStatusBar

    Application.DisplayStatusBar = True

    Application.StatusBar = "Hiding sheets before save..."

    Application.ScreenUpdating = False

    On Error GoTo ErrorHandler

    '**************************************

    ' Add password for opening workbook:

    Me.Password = C_WORKBOOK_OPEN_PASSWORD

    '**************************************

    ' Store the currently selected sheet(s) and active sheet:

    Set objActiveSheet = ActiveSheet

    Set shtsSelected = ThisWorkbook.Windows(1).SelectedSheets

    ' Hide sheets before saving:

    Call SaveStateAndHide

    If SaveAsUI Then   'user is doing a SaveAs...

        Cancel = True  'Cancel the original SaveAs

        ' Get filename (with path) for saving:

        fname = Application.GetSaveAsFilename( _

            fileFilter:="Excel Marcro-Enabled Workbook (*.xlsm),*.xlsm")

        If fname = False Then GoTo ExitPoint  'Exit if user hit Cancel

        ' Save the workbook:

        Application.EnableEvents = False  'Prevent this event from firing

        ThisWorkbook.SaveAs Filename:=fname, FileFormat:=52

          '52 = xlOpenXMLWorkbookMacroEnabled = xlsm (with macro's in 2007+)

        Application.EnableEvents = True   'Re-enable events

    Else

        ' Save the workbook:

        Application.EnableEvents = False  'Prevent this event from firing

        ThisWorkbook.Save

        Application.EnableEvents = True   'Re-enable events

    End If

ExitPoint:

    ' Save the workbook's sheet visibility settings and hide all sheets except the

    ' introduction sheet.

    bSaved = ThisWorkbook.Saved

    Application.StatusBar = "Unhiding sheets..."

    Call UnHideSheets

    ' Reselect previously selected sheet(s):

    shtsSelected.Select

    objActiveSheet.Activate

    ' Reset status bar:

    Application.StatusBar = False

    Application.DisplayStatusBar = bOldStatusBar

    Application.ScreenUpdating = True

    If bSaved Then ThisWorkbook.Saved = True

    Exit Sub

ErrorHandler:

    Application.EnableEvents = True   'So events are never left disabled.

    MsgBox "An error occurred during save." & Err.Number, vbCritical, "Error"

End Sub