zondag, 02 november 2014 12:59

Gemakkelijk checkboxen aanmaken

De volgende macro heb ik geschreven n.a.v. een vraag van iemand of het mogelijk was om snel per rij in Excel een aantal checkboxes aan te maken die allemaal koppelen naar de volgende kolom. Dus bijvoorbeeld in kolom D vanaf rij 5 20 checkboxes die linken naar kolom rij 5 t/m 25.

 Sub SnelAanmakenCheckBoxen()
    Dim str1 As String
    Dim str2 As String
    Dim str3 As String
    Dim str4 As String
    Dim OLEObj As OLEObject
    Application.ScreenUpdating = False
    
    
    str1 = InputBox("Geef een unieke naam ter identificatie van de checkboxen (b.v. verdediger,middenvelder,aanvaller):", "Naam")
    str2 = InputBox("In welke kolom moeten de checkboxen komen (D,E,F,etc):", "Kolom info")
    str3 = InputBox("Start checkboxen op rij (1,2,3,etc):", "Startrij")
    str4 = InputBox("Stop checkboxen op rij (1,2,3,etc):", "Stoprij")
    
    Dim i
    Dim nleft As Integer
    Dim ntop As Integer
    Dim nname As String
    
    If Val(str3) = 0 Or Val(str4) = 0 Then
        MsgBox ("Geen geldige rij opgegeven voor checkboxen")
        Exit Sub
    End If
        '
    For i = Val(str3) To Val(str4) 'cells from 1st to 10th
    
    nleft = Cells(i, str2).Left
    ntop = Cells(i, str2).Top
    
    
    Set OLEObj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
        DisplayAsIcon:=False, Left:=nleft, Top:=ntop, Width:=21.75, Height:=15 _
        )
        
     nname = str1 & i
        
     OLEObj.Name = nname
     OLEObj.Object.Caption = ""
     OLEObj.LinkedCell = Chr(Asc(str2) + 1) & i
     OLEObj.Object.Value = False
    
    Application.ScreenUpdating = True
    Next
End Sub

 Met deze macro kon hij zijn Excel gemakkelijk opbouwen zonder stuk voor stuk de checkboxes aan te hoeven maken.

Klik HIER voor de Excel

Gepubliceerd in Macro's en VBA

Als julliie de vorige tips en trucs over het zelf schrijven van een vba functie ook hebben gelezen en de smaak te pakken hebben dan gaan we nu wat functies bekijken die ik tegen ben gekomen waar we de werkbladnamen in gebruiken. Het voorbeeldbestand met de zelfgemaakte vba functies kun je hier downloaden!

Stappen:

Om de functies die we in ieder werkblad aan kunnen roepen toe te voegen kiezen we na het openen van een Excel / maken van een nieuwe Excel voor ALT-F11 en klikken in de menubalk bovenin op 'Invoegen - Module'. Daarna 'Kopiƫren' en 'Plakken' we de functies hieronder die we willen gebruiken met uiteindelijk het volgende resultaat:

Voorbeeld functies met werkbladnaam

In het voorbeeldbestand hebben we 12 tabbladen voor de maanden in een jaar.

Huidige werkbladnaam

Geef de naam van het huidige werkblad:

Function HuidigeWerkbladNaam() As String
    Application.Volatile True
    HuidigeWerkbladNaam = Application.Caller.Parent.Name
End Function

Eerste werkbladnaam

Geef de naam van het eerste werkblad:

Function EersteWerkbladNaam() As String
    Application.Volatile True
    With Application.Caller.Parent.Parent.Worksheets
    EersteWerkbladNaam = .Item(1).Name
    End With
End Function

Deze functie kunnen we nu ook heel eenvoudig in een andere functie gebruiken. Als voorbeeld gebruiken we de functie indirect waarmee we door een combinatie te maken tussen de nieuwe functie EersteWerkbladNaam() en de celverwijzing A3 eigenlijk zeggen 'Geef me de waarde uit cel A3 van het eerste werkblad'!

=INDIRECT(EersteWerkbladNaam() & "!A3")

Huidige positie werkblad

Geef het nummer / de positie van het huidige werkblad

Function HuidigeWerkpladPositie() As Integer
    Application.Volatile True
    HuidigeWerkpladPositie = Application.Caller.Parent.Index
End Function

Toon aantal werkbladen

Deze functie geeft het totaal aantal werkbladen aan wat er in een Excel file zit

Function AantalWerkbladen() As Integer
    Application.Volatile True
    AantalWerkbladen = Application.Caller.Parent.Parent.Worksheets.Count
End Function

Laatste werkbladnaam

Toon de naam van het laatste werkblad

Function LaaststeWerkbladNaam() As String
    Application.Volatile True
    With Application.Caller.Parent.Parent.Worksheets
    LaaststeWerkbladNaam = .Item(.Count).Name
    End With
End Function

Toon de naam van het vorige werkblad t.o.v. het huidige werkblad

Dit is een handige functie waarin we de naam van het vorige werkblad ophalen, staan we op het eerste werkblad (januari in het testbestand), dan toont de formule de maand december!

Function VorigeWerkbladNaam(Optional ByVal WS As Worksheet = Nothing) As String
    Application.Volatile True
    Dim S As String
    Dim Q As String
    If IsObject(Application.Caller) = True Then
    Set WS = Application.Caller.Worksheet
    If WS.Index = 1 Then
    With Application.Caller.Worksheet.Parent.Worksheets
    Set WS = .Item(.Count)
    End With
    Else
    Set WS = WS.Previous
    End If
    If InStr(1, WS.Name, " ", vbBinaryCompare) > 0 Then
    Q = "'"
    Else
    Q = vbNullString
    End If
    Else
    If WS Is Nothing Then
    Set WS = ActiveSheet
    End If
    If WS.Index = 1 Then
    With WS.Parent.Worksheets
    Set WS = .Item(.Count)
    End With
    Else
    Set WS = WS.Previous
    End If
    Q = vbNullString
    End If
    VorigeWerkbladNaam = Q & WS.Name & Q
End Function

Ook deze functie kunnen we eenvoudig in een andere functie gebruiken. Als voorbeeld gebruiken we nogmaals de functie indirect waarmee we door een combinatie te maken tussen de nieuwe functie EersteWerkbladNaam() en de celverwijzing A3 eigenlijk zeggen 'Geef me de waarde uit cel A3 van het vorige werkblad'!

=INDIRECT(VorigeWerkbladNaam() & "!A3")

 Volgende werkblad naam

Function VolgendeWerkbladNaam(Optional WS As Worksheet = Nothing) As String
    Application.Volatile True
    Dim S As String
    Dim Q As String
    If IsObject(Application.Caller) = True Then
    Set WS = Application.Caller.Worksheet
    If WS.Index = WS.Parent.Sheets.Count Then
    With Application.Caller.Worksheet.Parent.Worksheets
    Set WS = .Item(1)
    End With
    Else
    Set WS = WS.Next
    End If
    If InStr(1, WS.Name, " ", vbBinaryCompare) > 0 Then
    Q = "'"
    Else
    Q = vbNullString
    End If
    Else
    If WS Is Nothing Then
    Set WS = ActiveSheet
    End If
    If WS.Index = WS.Parent.Worksheets.Count Then
    With WS.Parent.Worksheets
    Set WS = .Item(1)
    End With
    Else
    Set WS = WS.Next
    End If
    Q = vbNullString
    End If
    VolgendeWerkbladNaam = Q & WS.Name & Q
End Function

=INDIRECT(VolgendWerkbladNaam() & "!A3" geeft ons ook weer de waarde van A3 op het volgende werkblad.

Een andere manier om een celwaarde van een vorig werkblad te krijgen is m.b.v. de volgende functie:

Function PakCelOpVorigWerkblad(Addr As String) As Variant
    Application.Volatile True
    With Application.Caller.Parent
    If .Index = 1 Then
    RefOnPrevSheet = _
    .Parent.Worksheets(.Parent.Worksheets.Count).Range(Addr).Value
    Else
    PakCelOpVorigWerkblad = .Previous.Range(Addr).Value
    End If
    End With
End Function

We geven als parameter een tekststring mee, bijvoorbeeld: =PakCelOpVorigWerkblad("A6"). Let op de dubbele quotes om A6!
Ook hier geldt weer, staan we op het eerste werkblad, pak dan de waarde uit de cel waar naar verwezen wordt op het laatste werkblad.

Wat opvalt is dat iedere functie Application.Volatile True heeft staan, dit betekent dat de functie niet alleen herberekend moet worden als de input parameter van waarde verandert, maar dat Excel moet herberekenen bij iedere wijziging van het werkblad.

Gepubliceerd in Macro's en VBA

Excel Software Shop

Web Analytics