VBA: Finding Hdc in an Excel worksheet or UserForm

• By clicking on Sheet1 the UserForm is displayed.
• Put the pointer on UF, hold the left mouse button down and drag the mouse.
• By closing the UF sub continues and draw an arc on the sheet.

• A new workbook
• Add a UserForm name = UserForm1

Private Declare Function Arc Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, 

ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
Private Declare Function ArcTo Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, 

ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim B As Long
    'activate a UC and draw on it  (finding your HDC)
    UserForm1.Show
    'Finding your HDC in Excel worksheet
    monhdc = 0
    Do While myhdc = 0
        myhdc = GetForegroundWindow()
        B = myhdc
        myhdc = GetDC(myhdc)
    Loop

    'Draw directly on Worksheet
    B = Arc(myhdc, 120, 500, 320, 400, 320, 400, 780, 500)
End Sub

Private Type POINTAPI
  X As Long
  Y As Long
End Type
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, _
  ByVal X As Long, ByVal Y As Long, lpPoint As Any) As Long

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Byte
Private monhdc As Long
Dim Buff As Boolean


Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Buff = True
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Do While myhdc = 0
        myhdc = GetForegroundWindow()
        myhdc = GetDC(monhdc)
    Loop
    If Button <> 1 Then Exit Sub
    hRPen = CreatePen(PS_SOLID, 10, RGB(0, 255, 0))
    DeleteObject SelectObject(myhdc, hRPen)
    If Buff Then
        MoveToEx myhdc, X * 1.32, Y * 1.32, &H0
        Buff = False
    End If
    LineTo myhdc, X * 1.32, Y * 1.32
    DoEvents

End Sub