wimgielis.com

Automatisch een vorm toevoegen met een macro

• 16/09/2017

Inleiding

Vaak schrijf ik macro's voor andere mensen zodat zij hun werk/taken kunnen versnellen en zich ontdoen van repetitieve, hersendodende handelingen. Ook voor mezelf schrijf ik geregeld macro's. De macro van vandaag voegt automatisch een vorm in met daaraan een macro gekoppeld.

Dat moet ik even uitleggen… Stel dat je een mooie macro geschreven of opgenomen hebt in VBA. Dan heb je een knop/vorm nodig waaraan die macro gekoppeld kan worden, zoals de blauwe vorm hierboven. Als je op de knop/vorm drukt wordt dan jouw macro uitgevoerd. Alternatief is een sneltoetscombinatie voorzien, zoals Ctrl + q, of een icoon in het menu / lint van Excel of de werkbalk Snelle toegang (QAT). Stel dat je kiest voor een vorm. Dan zijn dit de stappen die je zou kunnen doen om uiteindelijk het gewenste resultaat te hebben:

1. Voeg een vorm in via het menu, gewoonlijk kies ik voor een rechthoek met afgeronde hoeken
2. Trek de contouren van de vorm op het werkblad, zo bepaal je de grootte van de rechthoek
3. Als je bij de vorige stap de Alt knop ingedrukt houdt, dan zullen de randen van de knop automatisch samen vallen met de celranden van de cellen die het meest dichtbij zijn.
4. Vervolgens klik je op het tekstvak in het lint om zo de tekst op de knop aan te passen
5. Dan selecteer je die tekst (Ctrl + A) en centreer je de tekst horizontaal en verticaal
6. Je kiest eventueel een andere kleur voor de vorm (groen, rood, ...)
7. Je klikt met de rechtermuistoets op de rechthoek en koppelt een bestaande macro aan de knop
8. Dan klik je nog eens met de rechtermuistoets op de rechthoek en gaat naar de eigenschappen van de vorm. Daar kan je o.a. instellen dat de knop mag mee bewegen (op, neer, links, rechts) als rijen en/of kolommen veranderen (verwijderd, toegevoegd, verbreed, versmald, ...). De grootte van de knop willen we niet mee aanpassen.
9. De knop een naam geven is ook best practice, dat doe je in het naamvak.
10. Etc…

Dat is dus wel redelijk omslachtig en zeker als je dit vaak doet zoals ik. Tien of meer stappen uitvoeren is echt wel te veel. Hier valt te automatiseren! Als jij dit niet vindt, sla dan gerust dit artikel over ;-)

Hieronder toon ik jullie de macro die ik gebruik om alle stappen van hierboven automatisch te laten verlopen. De gebruiker wordt tijdens de macro gevraagd om invoer te doen, zoals de tekst die op de vorm te zien moet zijn.

Sub Add_Macro_Rectangle()
' Wim Gielis
' https://www.wimgielis.com
'''''
' Code to add a shape with a macro
' 06/09/17
'''''

    Dim ws                    As Worksheet
    Dim sh                    As Object
    Dim sText                 As String
    Dim sDimensions           As String
    Dim rDimensions           As Range
    Dim iColor                As Integer
    Dim s As String

    On Error Resume Next

    Set ws = ActiveSheet

    sDimensions = Trim(Application.InputBox("Please enter the dimensions of the shape (nr of rows x nr of columns)", "Shape dimensions", "3x3", , , , , 2))

    iColor = Trim(Application.InputBox("Please enter the color of the shape: 1 = blue, 2 = green, 3 = red", "Shape fill color", "2", , , , , 1))
    iColor = WorksheetFunction.Min(iColor, 3)
    iColor = WorksheetFunction.max(iColor, 0)

    Set rDimensions = Selection.Cells(1).Resize(CDbl(Split(sDimensions, "x")(0)), CDbl(Split(sDimensions, "x")(1)))

    With rDimensions
        Set sh = ws.Shapes.AddShape(msoShapeRoundedRectangle, .Left, .Top, .Width, .Height)
    End With

    With sh

        .name = "Run_macro"

        'centered horizontally 
        With .TextFrame2.TextRange.Characters(1, Len(sText)).ParagraphFormat
            .FirstLineIndent = 0                 'centered horizontally
            .Alignment = msoAlignCenter
        End With

        'centered vertically
        With .TextFrame2
            .VerticalAnchor = msoAnchorMiddle    'centered vertically
        End With

        With .Fill
            .ForeColor.RGB = Choose(iColor, RGB(0, 176, 240), RGB(146, 208, 80), RGB(255, 0, 0))
            .Transparency = 0
            .Solid
        End With

        With .Line
            .ForeColor.RGB = sh.Fill.ForeColor.RGB
            .Transparency = sh.Fill.Transparency
        End With

        .Placement = xlMove  'xlMoveAndSize = 1, xlMove = 2, xlFreeFloating = 3

        .Select
        Application.Dialogs(xlDialogAssignToObject).Show
        
        s = Split(.OnAction, "!")(1)
        If Len(s) = 0 Then s = .OnAction
        
        sText = Trim(Application.InputBox("Please enter the text on the shape", "Shape text", s, , , , , 2))
        If sText = "False" Or Len(sText) = 0 Then sText = "Add your caption"
        
        With .TextFrame.Characters
            .text = sText
            .Font.Color = vbWhite
            .Font.Bold = True
        End With

        rDimensions.Cells(1).Select

    End With

    On Error GoTo 0

    Set ws = Nothing

End Sub

Ik raad de lezer aan om de macro eens uit te proberen. Je kopieert de code in een module in VBA. Voer de code uit (eventueel met F8 om regel per regel te zien wat er gebeurt). Het resultaat zou moeten zijn dat er een knop gemaakt wordt op de plaats van de cursor, met een hoogte en breedte die je zelf kan ingeven (zoals 4x3). De tekst op de knop geef je ook in, net als de achtergrondkleur van de knop. Tot slot bepaal je nog welke macro er uitgevoerd dient te worden wanneer de gebruiker op de knop drukt.

Zo, keep on Excelling !

• Vorig Excel artikel »
• Volgend Excel artikel »