Mouse Event Timeout

Question

I was asked to program the ability to click on the image in Excel and add a figure on top of it (this is a body diagram for a physiotherapist, the form will indicate the patient's pain site). My code does this OK using the ActiveX control's mouse control event:

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 when the mouse cursor is over the chart, the form is not visible. Only when the mouse moves away from the chart does a shape appear.

I tried various methods to refresh the screen by selecting a cell, even changing the cursor position using the SetCursor method in lib user32 . Nothing seems to work, except that the user is actually moving the mouse.

: ActiveX 200 x 500 , jpeg- , .

Answer 1

, , :

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

!

Answer 2

: -

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

, , . . , . , 300 . , , . , , - .

, . , MouseUp (MouseUp - ), . , . . , , , . , .

, - ( ) , , .