Amend VBA

[mkbrehm54]

I have an amazing macro (see below) but I need some additional things added to it. It will be painfully obvious I'm not a coder as I've tried to add these simple things and just keep getting errors. THANK YOU SO MUCH FOR HELPING ME OUT.

In addition to the VBA code below I'd like to add the following to be automatic upon opening file (note this is my template and some versions may have more or less than 3 dash* tabs)

1. Hide:
Both Scroll bars
all Tabs
Formula bar
Gridlines
Headings
Tool bar
Status bar


2. For all Dash* Tabs (dash1, dash2, dash3, etc):
Lock scroll area to A1:Z41
Zoom to A1:Z41 (so regardless of what screen size is being used it zooms to this area in full)

3. Always open to Dash1 cell A1

4. Protect all sheets with ‘password’ (allow users to select unlocked cells only)
Protect workbook with ‘password’


CURRENT VBA CODE:

Option Explicit
Dim oSheet As Object
Dim bSaved As Boolean

Private Sub Workbook_Open()


Application.ScreenUpdating = False
Application.EnableEvents = False

Call sbShowSheets

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub


Sub sbShowSheets()

On Error Resume Next

For Each oSheet In ActiveWorkbook.Sheets

If oSheet.Name <> shtSplash.Name Then oSheet.Visible = xlSheetVisible

Next oSheet

shtSplash.Visible = xlSheetVeryHidden
info.Visible = xlSheetVeryHidden
data.Visible = xlSheetVeryHidden
pivot.Visible = xlSheetVeryHidden

ActiveWorkbook.Saved = True



On Error GoTo 0

End Sub
Sub sbHideSheets()

On Error Resume Next

shtSplash.Visible = xlSheetVisible

For Each oSheet In ActiveWorkbook.Sheets

If oSheet.Name <> shtSplash.Name Then oSheet.Visible = xlSheetVeryHidden

Next oSheet

On Error GoTo 0

End Sub

 

[Jimmypop]

Hi there

Try the code below... Note that this was done on the fly and some errors might exist... However I believe these can be sorted with minor debugging... Let us know if this is what you wanted...

Option Explicit
Dim oSheet          As Object
Dim bSaved          As Boolean
Private Sub Workbook_Open()
    Application.ScreenUpdating = FALSE
    Application.EnableEvents = FALSE
    Call sbShowSheets
    ' Hide Scroll bars, Tabs, Formula bar, Gridlines, Headings, Tool bar and Status bar
    ActiveWindow.DisplayGridlines = FALSE
    ActiveWindow.DisplayHeadings = FALSE
    Application.DisplayFormulaBar = FALSE
    Application.DisplayStatusBar = FALSE
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
    ActiveWindow.DisplayWorkbookTabs = FALSE
    ActiveWindow.DisplayHorizontalScrollBar = FALSE
    ActiveWindow.DisplayVerticalScrollBar = FALSE
    ' Lock scroll area and Zoom to A1:Z41 for Dash* Tabs
    For Each oSheet In ActiveWorkbook.Sheets
        If InStr(1, oSheet.Name, "dash", vbTextCompare) = 1 Then
            oSheet.ScrollArea = "A1:Z41"
            oSheet.Activate
            ActiveWindow.Zoom = TRUE
        End If
    Next oSheet
    ' Always open to Dash1 cell A1
    Sheets("Dash1").Select
    Range("A1").Select
    ' Protect all sheets with 'password' (allow users to select unlocked cells only) and protect workbook with 'password'
    For Each oSheet In ActiveWorkbook.Sheets
        oSheet.Protect "password", AllowSelectingLockedCells:=True
    Next oSheet
    ActiveWorkbook.Protect "password"
    ' Hide all sheets except the Splash screen
    Call sbHideSheets
    Application.ScreenUpdating = TRUE
    Application.EnableEvents = TRUE
End Sub
Sub sbShowSheets()
    On Error Resume Next
    For Each oSheet In ActiveWorkbook.Sheets
        If oSheet.Name <> shtSplash.Name Then oSheet.Visible = xlSheetVisible
    Next oSheet
    shtSplash.Visible = xlSheetVeryHidden
    info.Visible = xlSheetVeryHidden
    Data.Visible = xlSheetVeryHidden
    pivot.Visible = xlSheetVeryHidden
    ActiveWorkbook.Saved = TRUE
    On Error GoTo 0
End Sub
Sub sbHideSheets()
    On Error Resume Next
    For Each oSheet In ActiveWorkbook.Sheets
        If oSheet.Name <> "shtSplash" Then
            oSheet.Visible = xlSheetVeryHidden
        End If
    Next oSheet
    Sheets("shtSplash").Visible = xlSheetVisible
    On Error GoTo 0
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ActiveWindow.DisplayGridlines = TRUE
    ActiveWindow.DisplayHeadings = TRUE
    Application.DisplayFormulaBar = TRUE
    Application.DisplayStatusBar = TRUE
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
    ActiveWindow.DisplayWorkbookTabs = TRUE
    ActiveWindow.DisplayHorizontalScrollBar = TRUE
    ActiveWindow.DisplayVerticalScrollBar = TRUE
End Sub

 

[HaHoBe]

Hi Jimmypop,

in sbHideSheets I would place the line

    Sheets("shtSplash").Visible = xlSheetVisible

before the loop and comment out the "Error Handling" which is an error ignoring instead.

And for what I think you would need to add a call to sbHideSheets in Workbook_BeforeClose.

Ciao,
Holger

 

[Jimmypop]

Hi Jimmypop,

in sbHideSheets I would place the line

    Sheets("shtSplash").Visible = xlSheetVisible

before the loop and comment out the "Error Handling" which is an error ignoring instead.

And for what I think you would need to add a call to sbHideSheets in Workbook_BeforeClose.

Ciao,
Holger

Thanks for the suggestions... Will see to update quickly for OP

 

[HaHoBe]

Hi mkbrehm54,

if you have not made the workbook a "Dictator Workbook" (no other workbok may be open at the same time) I would suggest to use 2 more events in ThisWorkbook: Workbook_Deactivate which is triggered when any other workbook gets the focus (get back to the normal look of Excel) and Workbook_Activate when focus is back on the workbook with code. Depending on if you need to make sure that no other user may get information from the sheets being visible the code may be altered to setup the look for the workbook in question and put in procedure(s)..

Ciao,
Holger

 

[Jimmypop]

Hi @mkbrehm54

See updated as per suggestion from @HaHoBe ... Hope I got it right... Tested quickly and look to achieve what you want...(I hope )... I am not sure how to do the Dictator Workbook... perhaps HaHoBe could assist....

Note: Make sure to replace "password" in the code with your desired password for protection.

Also, make sure to create a sheet named "shtSplash" for the splash screen to work properly. You can customize the splash screen as per your requirements, or remove it and replace with your own...

Option Explicit
Dim oSheet          As Object
Dim bSaved          As Boolean
Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Call sbShowSheets
    ' Hide Scroll bars, Tabs, Formula bar, Gridlines, Headings, Tool bar and Status bar
    ActiveWindow.DisplayGridlines = False
    ActiveWindow.DisplayHeadings = False
    Application.DisplayFormulaBar = False
    Application.DisplayStatusBar = False
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
    ActiveWindow.DisplayWorkbookTabs = False
    ActiveWindow.DisplayHorizontalScrollBar = False
    ActiveWindow.DisplayVerticalScrollBar = False
    ' Lock scroll area and Zoom to A1:Z41 for Dash* Tabs
    For Each oSheet In ActiveWorkbook.Sheets
        If InStr(1, oSheet.Name, "dash", vbTextCompare) = 1 Then
            oSheet.ScrollArea = "A1:Z41"
            oSheet.Activate
            ActiveWindow.Zoom = True
        End If
    Next oSheet
    ' Always open to Dash1 cell A1
    Sheets("Dash1").Select
    Range("A1").Select
    ' Protect all sheets with 'password' (allow users to select unlocked cells only) and protect workbook with 'password'
    For Each oSheet In ActiveWorkbook.Sheets
        oSheet.Protect "password", ActiveSheet.EnableSelection = xlUnlockedCells
    Next oSheet
    ActiveWorkbook.Protect "password"
    ' Hide all sheets except the Splash screen
    Call sbHideSheets
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub
Sub sbShowSheets()
    On Error Resume Next
    For Each oSheet In ActiveWorkbook.Sheets
        If oSheet.Name <> shtSplash.Name Then oSheet.Visible = xlSheetVisible
    Next oSheet
    shtSplash.Visible = xlSheetVeryHidden
    info.Visible = xlSheetVeryHidden
    Data.Visible = xlSheetVeryHidden
    pivot.Visible = xlSheetVeryHidden
    ActiveWorkbook.Saved = True
    On Error GoTo 0
End Sub
Sub sbHideSheets()
    On Error Resume Next
    Sheets("shtSplash").Visible = xlSheetVisible
    For Each oSheet In ActiveWorkbook.Sheets
        If oSheet.Name <> "shtSplash" Then
            oSheet.Visible = xlSheetVeryHidden
        End If
    Next oSheet
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call sbHideSheets
    ActiveWindow.DisplayGridlines = True
    ActiveWindow.DisplayHeadings = True
    Application.DisplayFormulaBar = True
    Application.DisplayStatusBar = True
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
    ActiveWindow.DisplayWorkbookTabs = True
    ActiveWindow.DisplayHorizontalScrollBar = True
    ActiveWindow.DisplayVerticalScrollBar = True
End Sub