Active content error allowing unauthorised access to sheets

[Throughstream]

Hi I've set up my document to always load up a certain sheet and then the user has to enable macro's and enter a password to access any of the other sheets. However for some reason I sometime get "Some active content has been disabled" which allows the user to go on any sheet without having to put any password in??

Is there anyway to stop this?

Cheers

[AliGW]

Can you please share a sample workbook displaying the problem?

[Throughstream]

Hi hmmm not easily as it contains sensitive information. I could give you the coding from “thisWorkbook” if that helps?

[AliGW]

That would be a start, however might not be enough. Can you produce a desensitised copy and share that?

Is the workbook being saved as .xlsx at any point instead of .xlsm?

Are you really still using Excel 2007?

[Throughstream]

Hi sorry I know it would make it easier but I wouldn't feel comfortable even producing a desensitised copy unless it was a last resort.

Option Explicit
 
Const WelcomePage = "View 2"
 
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)
     Dim newWB As Workbook
     Dim nameWB As String
     nameWB = ThisWorkbook.Name
     nameWB = Left(nameWB, Len(nameWB) - 4) & "xltx"
      '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
    
    ThisWorkbook.Saved = True
    
    Application.DisplayAlerts = False
    Sheet27.Cells.Copy
    Set newWB = Workbooks.Add
    With newWB
        .Sheets(1).Range("A1").PasteSpecial xlPasteValues
        .Sheets(1).Range("A1").PasteSpecial xlPasteFormats
        .Sheets(1).Range("A1").PasteSpecial xlPasteColumnWidths
        .Sheets(1).Range("A1").Select
        .Sheets(1).Name = "View 2"
        .Sheets(1).Protect Password = "abc"
       
        .SaveAs Filename:="D:\" & nameWB, FileFormat:= _
        xlOpenXMLTemplate
       .Close False
    End With
     Application.DisplayAlerts = True
     Application.EnableEvents = True
     
End Sub
 
Private Sub Workbook_Open()
     'Unhide all worksheets
    Application.ScreenUpdating = False
    Call ShowAllSheets
    Application.ScreenUpdating = True
    Sheet27.Activate
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 (*.xlsm), *.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 = xlSheetHidden
    Next ws
     
    Worksheets(WelcomePage).Activate
    ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
End Sub
 
Private Sub ShowAllSheets()
    Sheets("Rota").Visible = xlSheetVisible
        Sheets("Hours").Visible = xlSheetVisible

                                                Sheets("View 2").Visible = xlSheetVisible

End Sub

Haha well I use 2007 at home and 2010 at work.

The work book is saved as both a .xlsm and a .xlsx at the same time in two locations however it was doing the "active content error" before I started saving it as a .xlsx as well.

Could it just be that the admin's at my work have made it so that it automatically disabled active content?

[AliGW]

I think the admins at work need speaking to first - you need to eliminate that before trying to troubleshoot any further.

By the way, your thread title is a bit vague - can you please make it a bit more detailed? Thanks.

[Throughstream]

No problem, is there any way to make it so the document doesn’t open any sheets or only opens a specific sheet unless active content is enabled?

[AliGW]

In answer to your latest question - possibly. Make that part of your improved thread title. You'll have to wait for a VBA expert. Most people aren't up at this time on a Saturday!

EDIT: Title MUCH better - thanks.