How to monitor shape selection in worksheet using vba?

Question

I'm trying to do something very simple in Excel using VBA. In the worksheet, I have several textboxes (shapes). I just want to get the value and the color code of the shape that the user selects by mouse clicks. And when the box is moved, I also want to get the position of the box. Is this possible?

I tried the following, but not sure if this is the way to do. I suppose what I'm missing is which function to use to consistently monitor the sheet.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sr As Variant
    
    Set sr = Selection.ShapeRange
    
    If Not sr Is Nothing Then
        MsgBox "selecting box"
    
    End If

End Sub

I also tried using Worksheet_Activate(), but it does something only when the user activates the sheet.

Answer 1

I have several textboxes (shapes). I just want to get the value and the color code of the shape that the user selects by mouse clicks. And when the box is moved, I also want to get the position of the box. Is this possible?

If it is a shape textbox; inserted via Insert Tab | Shapes | Textbox then yes, it is possible using Application.Caller property and the GetAsyncKeyState API.

Basic Preparation:

1. Add 2 to 3 shapes (textboxes) by clicking on Insert Tab | Shapes | Textbox.
2. Add text or change colors for testing.
3. Insert a module and paste the below code.
4. Right click a textbox and click on Assign Macro. Select the Sample(in this case).
5. Click OK.
6. Repeat the steps for other textboxes.

Logic:

1. Application.Caller will return information about how Visual Basic was called. In this case it will return the name of the shape.. For example Text Box1
2. We get a shape object from that
3. Shape.TextFrame2.TextRange.Text will give the content of the textbox
4. Shape.Fill.ForeColor.RGB will give the color of the textbox
5. Now comes the trickiest part. Since there is no mouse event for the shape, we will get the new location when the user releases the left mouse button. We will get the initial location using Shape.Top and Shape.left.
6. And to exit the loop we will stop it either using a key say F9 (Feel free to change this) or when the user releases the left click button.
7. We are using GetAsyncKeyState(VK_F9) as an additional measure to stop the loop in case the user doesn't move the shape. If you do not want to use this then you can use a boolean variable to stop the loop and you can set the variable in the Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) so that the loop stops when a user selects a cell.

Drawback:

1. If the shape is already selected after the message box which displays the location then the code will not work as the "Left Clicking" is not simulated. You will have to click on a cell or something else (basically deselect the shape) and and re click on the shape.
2. If you right click on the shape and then select the shape to move it, the code will not work as the "Left Clicking" is not simulated.

Basically for this code to work you have to left click on a shape which is not previously selected.

Code:

Option Explicit

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Const VK_F9 = &H78

Dim oldLeft As Single, oldTop As Single
Dim newLeft As Single, newTop As Single

Sub Sample()
    Dim shp As Shape
    
    oldLeft = 0: oldTop = 0
    
    '~~> Get the shape that called the clicking of the shape
    Set shp = ActiveSheet.Shapes(Application.Caller)
    
    '~~> This is required so that the shape is selected
    '~~> when clicked else clicking will simply run the macro
    shp.Select
   
    oldTop = shp.Top: oldLeft = shp.Left
    
    '~~> Show the textbox text and color
    MsgBox "Shape Text = " & shp.TextFrame2.TextRange.Text & vbNewLine & _
           "Shape Color = " & shp.Fill.ForeColor.RGB
           
    '~~> Track the cursor postion till the time user presses F9
    Do Until GetAsyncKeyState(VK_F9)
        '~~> Need to reset this
        newTop = 0: newLeft = 0
        
        '~~> Get the new position
        newTop = shp.Top: newLeft = shp.Left
        
        '~~> If it is different then store it in a variable
        '~~> and exit (User has released the mouse)
        If newTop <> oldTop Or newLeft <> oldLeft Then
            MsgBox "Old position: X=" & oldTop & ":Y=" & oldLeft & vbNewLine & _
                   "New position: X=" & newTop & ":Y=" & newLeft
            Exit Do
        End If
        DoEvents
    Loop
End Sub  

In Action