VBA : Trouver Hdc d'une feuille Excell et Userform

Pour démontrer la façon de trouver les Hdc j'ai ajouté deux petits exemples de dessin.
En cliquant sur la Feuil1 l'Userform est affiché.
Mettre le pointeur sur l'UF, maintenir le bouton gauche enfoncé et déplacer la souris.
En fermant l'UF la sub continue et dessine un arc de cercle sur la feuille.

PREPARATION

Un nouveau classeur
Ajouter un UserForm name=UserForm1

Dans un module de feuille

Coller le code suivant dans Feuil1...

Private monhdc As Long
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
    'activer un UC et dessiner dessus (trouver sont HDC)
    UserForm1.Show
    'Trouver le HDC d'une feuille Excel
    monhdc = 0
    Do While monhdc = 0
        monhdc = GetForegroundWindow()
        B = monhdc
        monhdc = GetDC(monhdc)
    Loop

    'Dessiner directement sur une feuille Excel
    B = Arc(monhdc, 120, 500, 320, 400, 320, 400, 780, 500)
End Sub

Dans le module de l'UserForm

Coller le code suivant...

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

End Sub