How to add a textbox near the current mouse position (VBA)?

If you select the shape that you have just created, then you have lost your original selection.
Perhaps this will help. It might need some tweaking.

Sub AddTextBoxNearSelection()
    Dim sh As Shape
    Set sh = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 495#, 360#, 72#, 72#, Selection.Range)
    sh.Top = Selection.Information(wdVerticalPositionRelativeToPage)
End Sub

It does not place the textbox near the last position but at a lower place.

Sub NewCanvasTextbox()

    Dim docNew As Document
    Dim shpCanvas As Shape
    Dim sh As Shape
    Dim lngTop As Long
    Dim lngLeft As Long
   
    'add 2 spaces and a character to the selected text
    Selection.Text = Selection.Text & "  a"
    'select the last character of the selection (leaving the original text and 2 spaces
    Selection.Characters(Selection.Characters.Count).Select
    'get the top and left values of the selection
    lngLeft = Selection.Information (wdHorizontalPositionRelativeToPage)
    lngTop = Selection.Information(wdVerticalPositionRelativeToPage)
    'Add a drawing canvas
   'add a drawing canvas at the top and left coordinates
    Set shpCanvas = ActiveDocument.Shapes.AddCanvas _
        (Left:=lngLeft, Top:=lngTop, Width:=100, Height:=20)
    'Add a text box to the drawing canvas
   'add a atext box to the drawing canvas
    Set sh = shpCanvas.CanvasItems.AddTextbox _
        (Orientation:=msoTextOrientationHorizontal, _
        Left:=1, Top:=1, Width:=shpCanvas.Width - 1, Height:=shpCanvas.Height - 1)
   
When you select text, make sure that you don't include the line break character.
   
End Sub

Me again...
I tried the previous routine after randomly positioning the cursor (i.e. a new line and few tabs) and the textbox appeared on the next line.
It occurred to me that the tb was being positioned on a line break...hence the slight change below...

Sub NewCanvasTextbox()

    Dim docNew As Document
    Dim shpCanvas As Shape
    Dim sh As Shape
    Dim lngTop As Long
    Dim lngLeft As Long
   
    'line break...add a leading blank
    If Asc(Selection.Text) = 13 Then
        Selection.Text = " " & Selection.Text
        Selection.Characters(1).Select
    Else ' add trailing blanks and a chararcter
        Selection.Text = Selection.Text & "  a"
        Selection.Characters(Selection.Characters.Count).Select
    End If
    lngLeft = Selection.Information(wdHorizontalPositionRelativeToPage)
    lngTop = Selection.Information(wdVerticalPositionRelativeToPage)
   
    'Add a text box to the drawing canvas
    Set shpCanvas = ActiveDocument.Shapes.AddCanvas _
        (Left:=lngLeft, Top:=lngTop, Width:=100, Height:=20)

    Set sh = shpCanvas.CanvasItems.AddTextbox _
        (Orientation:=msoTextOrientationHorizontal, _
        Left:=1, Top:=1, Width:=shpCanvas.Width - 1, Height:=shpCanvas.Height - 1)
    sh.TextFrame.TextRange.Text = "Guess Who?"
   
End Sub