Amend VBA

M

mkbrehm54

New Member
Joined
Mar 8, 2023
Messages
3
Office Version
  1. 2016
Platform
  1. Windows
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
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Sort by date Sort by votes
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...

VBA Code: 
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
 
Upvote 0
Solution
Hi Jimmypop,

in sbHideSheets I would place the line

VBA Code: 
    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
 
Upvote 0
HaHoBe said:
Hi Jimmypop,

in sbHideSheets I would place the line

VBA Code: 
    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
Click to expand...

Thanks for the suggestions... Will see to update quickly for OP
 
Upvote 0
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
 
Upvote 0
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...

VBA Code: 
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question Question
Error with code
Replies
1
Views
517
nitro2481
N
G
  • Question Question
How do I create a macro to show/hide several worksheets in my displayed list?
Replies
1
Views
2K
Gavin T
Gavin T
P
  • Question Question
Copy a range as picture in Excel, then export and paste it in Word VBA?
Replies
0
Views
2K
perola.rike
P

Forum statistics

Threads
1,223,903
Messages
6,175,289
Members
452,631
Latest member
a_potato

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top