PLACE NUMBERS FROM 1 TO 99.......AT MOSE CLICK X, Y COORDINATES

Hello,
Please make a macro:

1. I write 7 and around the number circle as an example.
2. I select the sample, created in step 1
3. I run macro1 /must be created/ 
4. I click on page anywhere and at click point appears 8.
The printout should look like the example created in step 1 
5. I click on other place on same page or on other page and appear 9 
The printout should look like the example created in step 1


5.To stop macro I click on sample, created in step 1 or......one other action


Greetings!

Parents
  • This has just a small modification made to another macro that I had already written to "paste where I click".

    To use this, you would:

    1. Select your original label (can be multiple shapes, but should include exactly one text shape).
    2. Copy (Ctrl+C).
    3. Run the macro.
    4. Mouse click to paste (text will be updated with each paste operation).
    5. Esc to stop placing duplicates.

    Sub JQ_Paste_Where_I_Click_Multi_Increment_Integer_Text()
    Dim dblX As Double
    Dim dblY As Double
    Dim lngShiftState As Long
    Dim blnGotClick As Boolean
    Dim blnDone As Boolean
    Dim sr As ShapeRange
    Dim sLabelText As Shape
    Dim lngNextIncrement As Long
    Const strMacroName = "Paste Where I Click Increment Integer Text"
    
        On Error GoTo ErrHandler
        
        If Not ActiveDocument Is Nothing Then
            If Not Application.Clipboard.Empty Then
                Do Until blnDone
                    get_coordinates_from_click dblX, dblY, lngShiftState, 10, True, cdrCursorSmallcrosshair, blnGotClick
                    If blnGotClick Then
                        ActiveDocument.BeginCommandGroup "PWIC Incr Int"
                        Set sr = ActiveLayer.PasteEx
                        If sr.Count > 0 Then
                            sr.SetPositionEx cdrCenter, dblX, dblY
                            '-----------------------------------
                            'added to increment text label
                            lngNextIncrement = lngNextIncrement + 1
                            Set sLabelText = sr.Shapes.FindShape(, cdrTextShape)
                            sLabelText.Text.Story = CStr(CLng(sLabelText.Text.Story) + lngNextIncrement)
                            '-----------------------------------
                        End If
                        ActiveDocument.EndCommandGroup
                    Else
                        blnDone = True
                    End If
                Loop
            Else
                MsgBox "Clipboard is empty.", vbExclamation, strMacroName
            End If
        Else
            MsgBox "No document is active.", vbExclamation, strMacroName
        End If
    
    ExitSub:
        If blnGotClick Then
            ActiveDocument.EndCommandGroup
            Refresh
        End If
        Exit Sub
    
    ErrHandler:
        MsgBox "Error occurred: " & Err.Description
        Resume ExitSub
    
    End Sub
    
    
    Sub get_coordinates_from_click(ByRef ClickX As Double, ByRef ClickY As Double, ByRef ShiftState As Long, ByVal Timeout As Long, ByVal Snap As Boolean, ByVal CursorShape As cdrCursorShape, ByRef ClickMade As Boolean)
    Dim dblClickX As Double
    Dim dblClickY As Double
    Dim lngShiftState As Long
    Dim blnCancelled As Boolean
    
        blnCancelled = True
        blnCancelled = ActiveDocument.GetUserClick(dblClickX, dblClickY, lngShiftState, Timeout, Snap, CursorShape)
              
        If blnCancelled = False Then
            ClickX = dblClickX
            ClickY = dblClickY
            ShiftState = lngShiftState
            
            ClickMade = True
        Else
            ClickMade = False
        End If
        
    End Sub
    

    Here is a video showing what it looks like in use: