Put the following into ThisWorkbook and Normal modules as indicated.
Hold Ctrl and Right-click to center "TheSun" under the cursor

''' ThisWorkbook module

Option Explicit
Private Declare Function GetKeyState32 Lib "user32" _
Alias "GetKeyState" (ByVal vKey As Integer) As Integer


Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, _
ByVal Target As Range, Cancel As Boolean)
Dim bCtrl As Long

' Right-click and hold Ctrl <<<

' is Ctrl pressed
bCtrl = GetKeyState32(vbKeyControl) < 0

If bCtrl Then
Cancel = True ' prevent the rt-click menu
TestCursorToPoints Sh
End If

End Sub

''' end ThisWorkbook module

''' code in normal module

Option Explicit
''' pmbthornton at gmail dot com

' re points per pixel
Private Const LOGPIXELSX As Long = 88&
Private Const POINTS_PER_INCH As Long = 72&
Private Declare Function GetDC Lib "user32" ( _
ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" ( _
ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long

' re cursor position
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function GetCursorPos Lib "user32.dll" ( _
ByRef lpPoint As POINTAPI) As Long

Private mPPP As Single ' points per pixel

Function CursorToPoints(X As Single, Y As Single) As Long
Dim x0 As Single, y0 As Single
Dim zm As Single
Dim rngCursor As Range
Dim pta As POINTAPI

On Error GoTo errH

If mPPP = 0 Then getPPP

Call GetCursorPos(pta)

With ActiveWindow

If .Panes.Count = 1 Then
x0 = .PointsToScreenPixelsX(0)
y0 = .PointsToScreenPixelsY(0)

ElseIf Val(Application.Version) = 12 Then

With .Panes(.Panes.Count)
x0 = .PointsToScreenPixelsX(0)
y0 = .PointsToScreenPixelsY(0)
End With
Else
Err.Raise 10100, , _
"To do: cater for Freeze Panes in 2000-2003"
End If

If x0 = 0 And y0 = 0 Then
Err.Raise 10200, , _
"At least part of the worksheet must be in view"
End If

zm = 100 / .Zoom

X = (pta.X - x0) * mPPP * zm
Y = (pta.Y - y0) * mPPP * zm

On Error Resume Next
' attempt to return the cell under the cursor
' btw, if only need to return the cell under the mouse
' this is all that's required
Set rngCursor = .RangeFromPoint(pta.X, pta.Y)
On Error GoTo errH

End With

If Not rngCursor Is Nothing Then

If rngCursor.Address = ActiveCell.Address Then
CursorToPoints = 2 ' mouse over activecell
Else
CursorToPoints = 1 ' mouse not over activecell
End If

ElseIf X < 0 Or Y < 0 Then
CursorToPoints = 0 ' mouse above or to left of visible cells
Else
CursorToPoints = -1 ' mouse to right or below visible cells
End If

Exit Function

errH:
MsgBox Err.Description, , "CursorToPoints"

End Function

Sub getPPP()
' get Points / Pixel
' typically ppp is 72/96 = 0.75 in systems with Normal Fonts
Dim hWin As Long
Dim dcDT As Long
Dim nDPI As Long

hWin = GetDesktopWindow
dcDT = GetDC(hWin)
nDPI = GetDeviceCaps(dcDT, LOGPIXELSX)
ReleaseDC hWin, dcDT
mPPP = POINTS_PER_INCH / nDPI

End Sub

''''''' Test code '''''''

Sub test()
TestCursorToPoints ActiveSheet
End Sub

Sub TestCursorToPoints(ws As Worksheet)
Dim bVis As Boolean, bCenter As Boolean
Dim res As Long
Dim X As Single, Y As Single

res = CursorToPoints(X, Y)

bVis = CBool(res)
bCenter = True

MoveTheSun ws, X, Y, bVis, bCenter

End Sub

Sub MoveTheSun(ws As Worksheet, X As Single, Y As Single, _
bVis As Boolean, bCenter As Boolean)
Dim nL As Single, nT As Single
Dim shp As Shape
Const cW As Single = 24, cH As Single = 24
Const cSUN As String = "TheSun"

nL = X
nT = Y
If bCenter Then
nL = nL - (cW / 2)
nT = nT - (cH / 2)
End If

On Error Resume Next
Set shp = ActiveSheet.Shapes(cSUN)
On Error GoTo 0

If shp Is Nothing Then
Set shp = ws.Shapes.AddShape(msoShapeSun, nL, nT, cW, cH)
shp.Fill.ForeColor.RGB = RGB(255, 240, 140)
shp.Line.ForeColor.RGB = RGB(255, 180, 0)
shp.Name = cSUN

Else
With shp
.Left = nL
.Top = nT
.Width = cW
.Height = cH
.Visible = bVis
End With
End If

End Sub


Regrds,
Peter T