wimgielis.com

Automatically adding a shape with a macro

• Sep. 16, 2017

Introduction

I often write macro codes for other people such that they can speed up their job / duties and get rid of all sorts of repetitive, brain-damaging actions. A lot of macros are also for personal use and help me a lot. Today's macro can automatically insert a shape to which a macro is assigned.

I guess I lost you there and you ask me to explain it… Imagine that you wrote or recorded a nice macro in VBA. Then you need a button/shape to which you can assign the macro, like the blue shape above. When you press on the shape your macro will be executed. Alternatively you can use a shortcut key, like Ctrl + q, or an icon in the menu / ribbon of Excel or the Quick Access Toolbar (QAT). Suppose you go for a shape. Then listed below you find the steps that are needed to eventually reach your goal:

1. Insert a shape via the menu, usually I opt for a rectangular shape with rounded corners
2. Draw the contours of the shape in your worksheet, the size of the shape is determined
3. If you hold the Alt key pressed while doing the previous step, the shape will snap to the grid. This means that the borders will be aligned with cell borders.
4. Next up on the list of actions, you click on the textbox in the ribbon to enter the text for the caption of the shape
5. After that, you select that text (Ctrl + A) and you center it horizontally and vertically
6. You can maybe go for another background fill color (green, red, ...)
7. You right-click on the rectangle and assign a macro of your liking to the shape
8. Then you right-click again on the rectangle and you head over to the Properties of the shape. Over there you can set a.o. that the shape should move (but not size) with rows and/or columns.
9. Choosing a descriptive name for the shape is also considered to be best practice, in the Name box you can enter a name.
10. Etc…

This is all quite cumbersome and for sure when you do these steps a lot (like I do). Executing 10 or more steps is just too much for me. Time to automate things! If you do not think that the steps are too much, just stop reading the remainder of the article ;-)

Below I would like to show you the macro that I use to replace all steps above and automate the creation of the shape. During the macro the user will be asked to do some input, like entering the text that he wants to see on top of the shape.

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

I would like to advise the reader to just try the macro. You can copy the macro code to a module in VBA. Execute the code (if you want use F8 to step through the macro code line by line and see what happens). The end result should be that a shape is created where the cursor resides, with its dimensions being chosen (like 4x3). The shape text can be entered, just as the background fill color of the shape. Finally you pick the macro that needs to be executed when the shape is clicked.

Keep on Excelling !

• « Previous Excel article
• Next Excel article »