Applying custom shortcut for a shape to the current cell I am on

Question

I am trying to create a custom shape with a hotkey. I want it to automatically go to a specific cell I am currently on instead of the same area every single time I run it with my hotkey.

Sub RedSquareShapeNoFill()
'
' RedSquareShapeNoFill Macro
'
' Keyboard Shortcut: Ctrl+q
'
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 197.25, 44.25, 96.75, 26.25). _
        Select
    Selection.ShapeRange.Fill.Visible = msoFalse
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .Weight = 1.5
    End With

End Sub

the 2nd and 3rd parameter of the AddShape command are the top and left corner of the shape. You need to change these numbers to reflect your current position. — teylyn, Aug 27 '19 at 20:28
^ See the [`AddShape`](https://learn.microsoft.com/en-us/office/vba/api/excel.shapes.addshape) documentation for more detail. — BigBen, Aug 27 '19 at 20:31

teylyn · Answer 1 · 2019-08-27T20:36:19.247

0

You need the top and left of the current cell and plug that into the AddShape parameters

Dim myTop As Double
Dim myLeft As Double
    myTop = Selection.Top
    myLeft = Selection.Left
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, myLeft, myTop, 96.75, 26.25). _
        Select

edited Aug 27 '19 at 20:36

answered Aug 27 '19 at 20:32

teylyn

34,374
4
53
73

1

@BigBen yes, thanks. That would be more accurate. I'll edit it. – teylyn Aug 27 '19 at 20:36
If I wanted to do this for an arrow and I added the same my left and my top parameters how do I make it so the arrow points to a random location or perhaps a fixed length to anywhere on the excel file? – hamghani Aug 27 '19 at 21:32

score 0 · Accepted Answer · answered Aug 27 '19 at 20:52

The current selection could be assigned to a range variable. Then, working with that range, one may use the .Left, .Top, .Width and .Height properties of the range.

Another good idea is to declare the shape as a variable and work with it and not with the Selection, because it is a bad practice - the selection can be a Range or a Shape object:

Sub RedSquareShapeNoFill()

    Dim myShape As Shape
    Dim wks As Worksheet: Set wks = ActiveSheet

    Dim selectionRange As Range
    Set selectionRange = Selection

    Set myShape = wks.Shapes.AddShape(msoShapeRectangle, _
                selectionRange.Left, _
                selectionRange.Top, _
                selectionRange.Width, _
                selectionRange.Height)

    With myShape.Line
        myShape.Fill.Visible = msoFalse
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Visible = msoTrue
        .Weight = 1.5
    End With

End Sub

Applying custom shortcut for a shape to the current cell I am on

2 Answers2