Search code examples
excelvba

How to pass a relative range as argument on button click

I want to set up a button that will, on click send a range as argument to the method it calls. The range would be relative to the placement of the button, as shown here:

Example 1

I cannot use absolute coordinates (as 'E5' in this example) because the button will be inserted dynamically in locations I cannot guess.

In the context of this work, some button may share the same name, which prevents me from just using Set button = ActiveSheet.Buttons(Application.Caller) in the receiving sub (not that it would crash, but it may refer to the wrong button instead of the real caller, which can only be fixed by modifying the name of the button).

So here I am, wondering if this is even possible. If not, I will have to write a method to make every button name unique, which would work (I did it in another project), but I am trying to avoid this as it will prevent me from using button names as absolute identifiers, as in a switch for example.

Solution

  • Try this out: in my short testing seems to work OK.

    I put some shapes on a worksheet (some with the same name) and assigned the sub Shape_Click to all of them. Clicking any shape (even one of those sharing a common name) reliably highlights the clicked-on shape.

    See Excel VBA Code: Compile Error in x64 Version ('PtrSafe' attribute required) about API declarations and 32- vs 64-bit VBA.

    Option Explicit

Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Type POINTAPI
    x As Long
    y As Long
End Type

Sub Shape_Click()
    Dim point As POINTAPI, obj As Object
    
    GetCursorPos point
    On Error Resume Next 'ignore error if problem
    Set obj = ActiveWindow.RangeFromPoint(point.x, point.y)
    On Error GoTo 0
    'Highlight the clicked object (for demo purposes...)
    If Not obj Is Nothing Then Highlight obj 
    'Do something useful with obj...
    
End Sub

'color `obj` differently from other shapes on the same sheet
Sub Highlight(obj As Object)
    Dim shp, match
    For Each shp In obj.Parent.Shapes
        'assuming no superimposed shapes...
        match = (shp.Left = obj.Left And shp.Top = obj.Top)
        shp.Fill.ForeColor.RGB = IIf(match, vbBlue, vbRed)
        DoEvents
    Next shp
End Sub