Guys Wondering if you can help
I use the following code so that when I click on the drawing screen it places a circle at that point
Dim sr As ShapeRange, s As Shape Dim x#, y#, w#, h#, dOffset# Dim doc As Document, retval As Long Dim origx As Double, origy As Double, origw As Double, origh As Double Dim xxx As Double, yyy As Double, shift As Long Dim RH As Double Set doc = ActiveDocument ActiveDocument.Unit = cdrMillimeter ActiveDocument.ReferencePoint = cdrCenter retval = doc.GetUserClick(xxx, yyy, shift, 10, False, cdrCursorWinCross) If OptionButton1.value = True Then RH = 2.4 / 2 If OptionButton2.value = True Then RH = 3.4 / 2 If OptionButton3.value = True Then RH = 5.4 / 2 If OptionButton4.value = True Then RH = 4.4 / 2 Set s = ActiveLayer.CreateEllipse2(xxx, yyy, RH, RH) s.Fill.UniformColor.RGBAssign 0, 0, 0 s.Outline.SetNoOutline If OptionButton5.value = True Then MsgBox "single" If OptionButton6.value = True Then MsgBox "multiple"
This Works fine but I have to click the button each time I want to put a circle on the screen
Is there a way of having it so that the user click stays active until the user either presses esc or clicks another button?
I want to be able to put multiple circles down without have to click the button to activate.
Many Thanks
Mark
VBA example (from X5 help file)
The following VBA example retrieves the coordinates of the point where the user clicks and draws a circle at that point. The circle fill depends on the modifier key state. If the Shift is pressed while the user clicked, red is applied. If Ctrl is pressed, green is added. If Alt is pressed, blue is applied. Therefore, pressing Ctrl + Shift + Alt produces a yellow circle. The macro loops until the user presses Esc to abort the procedure or time out interval of ten seconds elapses.
Sub Test()
Dim x As Double, y As Double
Dim Shift As Long
Dim b As Boolean
Dim s As Shape
Dim cr As Long, cg As Long, cb As Long
b = False
While Not b
b = ActiveDocument.GetUserClick(x, y, Shift, 10, False, cdrCursorEyeDrop)
If Not b Then
Set s = ActiveLayer.CreateEllipse(x - 0.1, y - 0.1, x + 0.1, y + 0.1)
cr = 0
cg = 0
cb = 0
If (Shift And 1) <> 0 Then cr = 255 ' Shift depressed - Add Red
If (Shift And 2) <> 0 Then cg = 255 ' Ctrl depressed - Add Green
If (Shift And 4) <> 0 Then cb = 255 ' Alt depressed - Add Blue
s.Fill.UniformColor.RGBAssign cr, cg, cb
End If
Wend
End Sub
Thank you so Much Modified it slightly and does exactly what I want Many Thanks Mark
Mek One last thing How can I send the escape key from a button I have tried SendKeys "{ESC}" but it doesnt work
Mark, did you ever find a solution to your question about sending the escape key from a macro? I have a very similar situation to what you've described above when using GetUserClick. I can't find a way to "disengage" that function without user interaction.
When you use B = ActiveDocument.GetUserClick(X, Y, Shift, 10, False, cdrCursorWinCross)
here 10 is the delay timeso if the user does not make the next click within 10 seconds, GetUserClick is terminatedTaras