Automatically adding a shape with a macro
- Sep. 16, 2017
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:
- Insert a shape via the menu, usually I opt for a rectangular shape with rounded corners
- Draw the contours of the shape in your worksheet, the size of the shape is determined
- 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.
- 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
- After that, you select that text (Ctrl + A) and you center it horizontally and vertically
- You can maybe go for another background fill color (green, red, ...)
- You right-click on the rectangle and assign a macro of your liking to the shape
- 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.
- Choosing a descriptive name for the shape is also considered to be best practice, in the Name box you can enter a name.
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 ' http://www.wimgielis.comDim 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" Then sText = "Add your caption" If 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 = NothingEnd 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 !