4

I've been asked to code the ability to click on an image in Excel and add a shape on top of it (it's a body diagram for a physiotherapist, the shape will indicate the site of the patient's pain). My code does this OK by using the mouse down event of an ActiveX image control:

Private Sub bodypic_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)

ClickShape x, y

End Sub

Sub ClickShape(x As Single, y As Single)

Dim shp As Shape
Dim cursor As Point

Set shp = ActiveSheet.Shapes.AddShape(msoShapeMathMultiply, x + ActiveSheet.Shapes("bodypic").Left, _
y + ActiveSheet.Shapes("bodypic").Top, 26, 26)

With shp.Fill

    .ForeColor.RGB = RGB(255, 0, 0)
    .BackColor.RGB = RGB(255, 0, 0)

End With

shp.Line.Visible = False

End Sub

The problem is that while the mouse cursor is over the diagram the shape is not visible. Only when the mouse is moved off of the diagram does the shape appear.

I've tried various methods to refresh the screen, selecting a cell, even changing the cursor position via the SetCursor method in Lib user32. Nothing seems to work except for the user actually moving the mouse.

To recreate the issue: insert an ActiveX image control roughly 200 x 500 px, add a jpeg image to the control, add the mouse down code to the worksheet and the click shape code to a module.

Community
  • 1
  • 1
Absinthe
  • 3,258
  • 6
  • 31
  • 70
  • Instead of mousedown cant you just use the click event? Same thing but most likely will solve the issue – Doug Coats Apr 09 '17 at 12:14
  • MouseDown is the 'click event' – Absinthe Apr 09 '17 at 12:19
  • Lol i literally meant the "_Click()" event. – Doug Coats Apr 09 '17 at 12:22
  • There's no such event in Excel as far as I know. Can you post a link to the docs for _Click()? – Absinthe Apr 09 '17 at 12:25
  • Just realised you mean the shape click event. I need to return the position of the mouse cursor relative to the image (to account for different screen resolutions, window states etc), how would you do that with _Click()? – Absinthe Apr 09 '17 at 12:32
  • Cant you just record mouse position within your code and then tell it where to be? Check this https://support.microsoft.com/en-us/help/152969/visual-basic-procedure-to-get-set-cursor-position – Doug Coats Apr 09 '17 at 12:36
  • Probably, but again screen res etc will vary meaning a ton of code is required. Thanks for the suggestion though. I just figured a hacky workaround but any other ideas are welcome. – Absinthe Apr 09 '17 at 12:39

2 Answers2

1

This is very hacky but I discovered that hiding and unhiding the image solves the problem:

ActiveSheet.Shapes("bodypic").Visible = False
ActiveSheet.Shapes("bodypic").Visible = True
End Sub

I'd welcome more elegant answers!

Absinthe
  • 3,258
  • 6
  • 31
  • 70
0

I have a limited amount of success with this code:-

Option Explicit

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Integer, ByVal y As Integer) As Integer

Sub ClickShape(ByVal x As Single, ByVal y As Single)

    Dim Shp As Shape
    Dim Pos As POINTAPI

    GetCursorPos Pos
    SetCursorPos Pos.x + 300, Pos.y
    With ActiveSheet
        With .Shapes("bodypic")
            x = x + .Left
            y = y + .Top
        End With
        Set Shp = .Shapes.AddShape(msoShapeMathMultiply, x, y, 26, 26)
    End With

    With Shp
        .Name = "Mark1"
        .Line.Visible = False
        With .Fill
            .ForeColor.RGB = RGB(255, 0, 0)
            .BackColor.RGB = RGB(255, 0, 0)
        End With
    End With
End Sub

In essence, what it does is to move the cursor out of the image. Then it takes about a second for the mark to appear. The delay will be longer the more marks there are. Note that my movement of 300 pixels is random. You would have to work out where to move it, so long as it is outside the image. I tried moving it back immediately, but that didn't work, and timing the return would be tricky because of the variations in the delay.

I experimented with another concept where I created the mark first and made it invisible. Then, on MouseUp (MouseUp is the more suitable event), I moved the mark and made it visible. That was faster, but it limits you to a single mark or condemns you to a lot of name management. Giving a name to the mark is a leftover from that experiment. Actually, it looked quite nice since I could move the mark by repeatedly clicking on different positions. If you need only one mark I recommend to pursue that idea.

If you need several marks, another leftover from my experiments is the idea to add a feature to delete (or hide) a mark, perhaps on double-click.

Variatus
  • 14,293
  • 2
  • 14
  • 30