Excel: VBA for automatically creating a button menu on each sheet of a workmap

This spring I wrote a VBA script which automatically looks at the number of sheets in a workmap and then create that number of menu buttons at the top of each sheet. By clicking those menu buttons you can navigate from sheet to sheet.

It should look somewhat like this:

The next four scripts should be in ThisWorkbook:

The first one starts as the workbook is opened. It is calling the script CreateButtons

Number 1:
Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Dim shtBlad As Worksheet
    
    'make all sheets visible
    For Each shtBlad In Worksheets
        shtBlad.Visible = True
    Next
    
    For Each shtBlad In Worksheets
        shtBlad.Activate
        shtBlad.Rows("1:1").RowHeight = 80
        ActiveWindow.DisplayHeadings = False
        Application.DisplayFormulaBar = False
    Next
        
    CreateButtons
    
    ActiveWindow.DisplayWorkbookTabs = False
    Worksheets(1).Activate
    
    Application.DisplayStatusBar = False
    Application.ExecuteExcel4Macro "Show.Toolbar(""Ribbon"",False)"

    Application.ScreenUpdating = True
End Sub

Number 2:
'this one disables the ribbon
Private Sub Workbook_Activate()
    Application.ExecuteExcel4Macro "Show.Toolbar(""Ribbon"",False)"
End Sub

Number 3:
'When the workbook is closed some stuff should be turned on again. The next two scripts are 'dealing with that
Private Sub Workbook_Deactivate()
    Application.ExecuteExcel4Macro "Show.Toolbar(""Ribbon"",True)"
    Application.DisplayStatusBar = True
End Sub

Number 4:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.ExecuteExcel4Macro "Show.Toolbar(""Ribbon"",True)"
    Application.DisplayStatusBar = True
End Sub

The next two scripts should be part of a module and is called by WorkBook_Open

Number 1:
Sub CreateButtons()
    Application.ScreenUpdating = False
    Dim shtBlad As Worksheet
    Dim shpknop As Shape
    Dim intLeft As Integer, intNummer As Integer, intTeller As Integer
    Dim arrSheetNames() As String 'array for sheetnames
    ReDim arrSheetNames(Worksheets.Count + 1)
    Dim strZoektekst As String
    
    'save sheet names in array
    intTeller = 1
    For Each shtBlad In Worksheets
        arrSheetNames(intTeller) = shtBlad.Name
        intTeller = intTeller + 1
    Next
    
    intNummer = 1
    
    'delete all buttons
    For Each shtBlad In Worksheets
        shtBlad.Activate

        For Each shpknop In ActiveSheet.Shapes
            If Left(shpknop.Name, 8) = "menubutton" Then
                shpknop.Select
                shpknop.Delete
            End If
        Next
    Next
    
    intLeft = 5
    intnummer = 1
    
    'put buttons on every sheet
    For Each shtBlad In Worksheets
        shtBlad.Activate
        For intteller = 1 To Worksheets.Count 
            ActiveSheet.Buttons.Add(intLeft, 5, 100, 20).Select
            With Selection
                .OnAction = "Navigate"
                .Characters.Text = Worksheets(intnummer).Name
                .Name = "menuknop" & intteller
                .Placement = xlFreeFloating
                .PrintObject = False
            End With
            intLeft = intLeft + 105
            intNummer = intNummer + 1
        Next
        Range("a1").Select
        intnummer = 1
        intLeft = 5
    Next
    
    Worksheets(1).Activate
    Range("a1").Select
    Application.ScreenUpdating = True
End Sub

In CreateButtons every button gets and action called Navigate:

Number 2:
Sub Navigate()
    Application.ScreenUpdating = False
    Dim varV As Variant
    Dim strNaam As String
    Dim shtBlad As Worksheet
    
    'make all the sheets visible
    For Each shtBlad In Worksheets
        shtBlad.Visible = True
    Next
    
    'this is needed in Excel 2013
    strNaam = ActiveSheet.Name

    Worksheets(strNaam).Activate

    'handles the onClick event
    varV = Application.Caller
    ActiveSheet.Shapes.Range(Array(varV)).Select
    strNaam = Selection.Characters.Text
    Range("a1").Select
    Worksheets(strNaam).Activate
    
    'hides all other sheets
    For Each shtBlad In Worksheets
        If shtBlad.Name <> ActiveSheet.Name Then
            shtBlad.Visible = False
        End If
    Next

    Application.ScreenUpdating = True

End Sub

Good luck and let me know what you think!

You can also download the file testvba.zip through this link:

https://drive.google.com/folderview?id=0B7HgkOwFZtdZVmhRQUZFM28yc1U&usp=sharing