Automatisch een vorm toevoegen met een macro

Inleiding

Vaak schrijf ik macro's voor andere mensen zodat zij hun werk/taken kunnen versnellen en zich ontdoen van repititieve, 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 ' http://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 On Error Resume Next Set ws = ActiveSheet sText = Trim(Application.InputBox("Please enter the text on the shape", "Shape text", "", , , , , 2)) If sText = "False" Then Exit Sub If Len(sText) = 0 Then Exit Sub 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" With .TextFrame.Characters .text = sText .Font.Color = vbWhite .Font.Bold = True End With 'centered horizontally With .TextFrame2.TextRange.Characters(1, Len(sText)).ParagraphFormat .FirstLineIndent = 0 .Alignment = msoAlignCenter End With 'centered vertically With .TextFrame2 .VerticalAnchor = msoAnchorMiddle 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 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 !




Over Wim

Wim Gielis is Business Intelligence consultant en Excel expert

Andere links