Doorgaan naar hoofdcontent

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:

Reacties

Populaire posts van deze blog

Excel: VBA script om wachtwoord te verwijderen

Af en toe krijg ik een vraag om een wachtwoord van een Excel blad te halen. Doodsimpel met VBA. Hier een script dat ik gebruik:

Sub WachtwoordCrack()
    Dim a As Integer, b As Integer, c As Integer, d As Integer, _
    e As Integer, f As Integer, g As Integer, h As Integer, _ 
I As Integer, j As Integer, k, m As Integer
    Dim begin As Date, eind As Date
    Dim duur As String
    Dim objSheet As Worksheet
    begin = TimeValue(Time)
    On Error Resume Next
    For Each objSheet In Application.Worksheets
        For a = 65 To 66: For b = 65 To 66: For c = 65 To 66
            For d = 65 To 66: For e = 65 To 66: For f = 65 To 66
                For g = 65 To 66: For h = 65 To 66: For I = 65 To 66
                    For j = 65 To 66: For k = 65 To 66: For m = 32 To 126
                        ActiveSheet.Unprotect Chr(a) & Chr(b) & _ 
 Chr(c) & Chr(d) & Chr(e) & Chr(f) & _ 
 Chr(g) & Chr(h) & Chr(I) & Chr(j) & Chr(k) & Chr(m)
                        If Ac…

Excel 2013: uniek aantal in draaitabel

Tot en met versie 2010 was het in Excel lastig om in een draaitabel een uniek aantal (DISTINCT COUNT) te tellen. We geven een voorbeeld op basis van een verkoperslijst. In deze lijst kunnen we zien welke verkopers welke artikelen hebben verkocht. Willen we nu in een draaitabel laten zien hoeveel artikelen een verkoper heeft verkocht, dan krijgen we wel de aantallen maar niet de unieke aantallen te zien.


Om toch de unieke aantallen te laten zien, hebben we een aantal stappen nodig.

Op het moment dat we de draaitabel invoegen, krijgen we in Excel 2013 dit dialoogvenster:


Onderaan zien we daar een nieuwe optie: Deze gegevens toevoegen aan het gegevensmodel. Deze optie moeten we aanvinken, voor we op OK klikken.

We krijgen dan een iets ander beeld dan normaal:


Normaliter krijgen we alleen de veldnamen. Nu zien we er het woord Bereik boven staan.

Voor het voorbeeld heb ik nu Verkoper toegevoegd aan Rijen en Artikelomschrijving aan Waarden.

Het resultaat is identiek aan het bovenste plaatje…

Excel: Speedometer met handleiding

Inleiding Echte speedometers met wijzertjes en zo kent het reguliere Excel niet. We kunnen wel zelf zoiets maken. En dat gaan we doen.
Hoe maken we zoiets?§We typen vanaf cel A1:

cijfers 1 1 1 1 1 1 1 1 1 1 10
De onderste 10 is de optelsom van de bovenste waarden.
§We maken hier een ringgrafiek van. §We wissen de labels. §We laten deze ring 270 graden laten draaien.


§Voor het onderste stuk kiezen we dan: Geen opvulling.