Force marcos to be enabled and lock cells

[quirkylwj]

Hello good people,

This is a related question and I'm a new user, so I'm not sure this is the spot for it - but here goes anyway:



I like your Force Macros code and it works well. In my workbook, I also use this code to lock cells after save so other users can't change the data.


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error Resume Next
'Resume to next line if any error occurs
Dim Cell As Range
With ActiveSheet
'first of all unprotect the entire
'sheet and unlock all cells
.Unprotect Password:="pc"
.Cells.Locked = False
'Now search for non blank cells
'and lock them and unlock blank cells
For Each Cell In ActiveSheet.UsedRange
If Cell.Value = "" Then
Cell.Locked = False
Else
Cell.Locked = True
End If
Next Cell
.Protect Password:="pc"
'Protect with blank password, you can change it
End With
Exit Sub
End Sub


How do I add this in to your code to run at the same time. I've tried just pasting it onto the bottom and it wont work. I assume becasue the two "before save" routines compete.

Hopefully you can help!

Cheers

Quirky

P.S Here is your force macros code:






Option Explicit

Const WelcomePage = "Macros"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Evaluate if workbook is saved and emulate default propmts
With ThisWorkbook
If Not .Saved Then
Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
vbYesNoCancel + vbExclamation)
Case Is = vbYes
'Call customized save routine
Call CustomSave
Case Is = vbNo
'Do not save
Case Is = vbCancel
'Set up procedure to cancel close
Cancel = True
End Select
End If

'If Cancel was clicked, turn events back on and cancel close,
'otherwise close the workbook without saving further changes
If Not Cancel = True Then
.Saved = True
Application.EnableEvents = True
.Close savechanges:=False
Else
Application.EnableEvents = True
End If
End With
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Call customized save routine and set workbook's saved property to true
'(To cancel regular saving)
Call CustomSave(SaveAsUI)
Cancel = True

'Turn events back on an set saved property to true
Application.EnableEvents = True
ThisWorkbook.Saved = True
End Sub

Private Sub Workbook_Open()
'Unhide all worksheets
Application.ScreenUpdating = False
Call ShowAllSheets
Application.ScreenUpdating = True
End Sub

Private Sub CustomSave(Optional SaveAs As Boolean)
Dim ws As Worksheet, aWs As Worksheet, newFname As String
'Turn off screen flashing
Application.ScreenUpdating = False

'Record active worksheet
Set aWs = ActiveSheet

'Hide all sheets
Call HideAllSheets

'Save workbook directly or prompt for saveas filename
If SaveAs = True Then
newFname = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If Not newFname = "False" Then ThisWorkbook.SaveAs newFname
Else
ThisWorkbook.Save
End If

'Restore file to where user was
Call ShowAllSheets
aWs.Activate

'Restore screen updates
Application.ScreenUpdating = True
End Sub

Private Sub HideAllSheets()
'Hide all worksheets except the macro welcome page
Dim ws As Worksheet

Worksheets(WelcomePage).Visible = xlSheetVisible

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
Next ws

Worksheets(WelcomePage).Activate
End Sub

Private Sub ShowAllSheets()
'Show all worksheets except the macro welcome page

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
Next ws

Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub

[quirkylwj]

I was able to solve my own problem by simply pasting my code into the "before Save" section of Kens code. Not sure if this is the correct way to do it but it appears to work.

[quirkylwj]

Ok so it works, but NOW I want to leave about 6 specific cells on two different sheets unlocked, even if they have data in them..... I'm thinking something like:


Sheets("SES Report").Select
Range("C8").Select
Selection.Locked = False
Selection.FormulaHidden = False


But if I just paste it in it gives me a compiler error. Any tips?