Option Explicit

Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

' Create custom variable that holds two integers

Type POINTAPI

   Xcoord As Long

   Ycoord As Long

End Type

Declare Function GetSystemMetrics Lib "user32.dll" _

(ByVal nIndex As Long) As Long

Const SM_CXSCREEN = 0

Const SM_CYSCREEN = 1

Const DPI As Double = 96#

Const PPI As Double = 72#

Private Const LOGPIXELSX As Long = &H58&

Private Const LOGPIXELSY As Long = &H5A&

Private Declare Function GetDeviceCaps Lib "gdi32" ( _

    ByVal hDc As Long, _

    ByVal nIndex As Long _

    ) As Long

Private Declare Function GetDC Lib "user32" ( _

    ByVal hWnd As Long _

    ) As Long

Private Declare Sub ReleaseDC Lib "user32" ( _

    ByVal hWnd As Long, _

    ByVal hDc As Long _

    )

Sub addShape()

'

' addShape Macro

'

'

    Dim lngMetricsValueCx As Long, lngMetricsValueCy As Long

  

    lngMetricsValueCx = GetSystemMetrics(SM_CXSCREEN)

    lngMetricsValueCy = GetSystemMetrics(SM_CYSCREEN)

    Debug.Print "Screen: " & lngMetricsValueCx & " * " & lngMetricsValueCy

   

    Dim shp As Shape

    

    'Set Shape = ActiveSheet.Shapes.addShape(msoShapeRectangle, 163.5, 133.5, 52.5, 15.75)

    Debug.Print "ActiveCell: " & ActiveCell.left & "," & ActiveCell.top & "," & ActiveCell.Width & "," & ActiveCell.Height

    Dim llCoord As POINTAPI

    ' Get the cursor positions

    GetCursorPos llCoord

    Debug.Print "X Cursor: " & llCoord.Xcoord & vbNewLine & "Y Cursor: " & llCoord.Ycoord

    Debug.Print "X Position: " & Application.ActiveWindow.PointsToScreenPixelsX(0) _

        + ActiveCell.left * DPI / PPI * (ActiveWindow.Zoom / 100) _

        & vbNewLine & "Y Position: " & Application.ActiveWindow.PointsToScreenPixelsY(0) _

        + ActiveCell.top * DPI / PPI * (ActiveWindow.Zoom / 100)

    'Debug.Print ActiveCell.left * DPI / PPI & "," & ActiveCell.top * DPI / PPI

    Dim p As POINTAPI

    p.Xcoord = (llCoord.Xcoord - Application.ActiveWindow.PointsToScreenPixelsX(0)) _

        * PPI / DPI / (ActiveWindow.Zoom / 100)

    p.Ycoord = (llCoord.Ycoord - Application.ActiveWindow.PointsToScreenPixelsY(0)) _

        * PPI / DPI / (ActiveWindow.Zoom / 100)

    Set shp = ActiveSheet.Shapes.addShape(msoShapeRectangle, p.Xcoord, p.Ycoord, 52.5, 15.75)

End Sub

Private Sub GET_DPI()

    Dim hWnd As Long

    Dim hDc As Long

    hWnd = Excel.Application.hWnd

    hDc = GetDC(hWnd)

    '水平方向DPI

        Debug.Print GetDeviceCaps(hDc, LOGPIXELSX)

    '垂直方向DPI

        Debug.Print GetDeviceCaps(hDc, LOGPIXELSY)

    ReleaseDC hWnd, hDc

End Sub