VBA: Finding Hdc in an Excel worksheet or UserForm

December 2016





Here are two small examples on how to find Hdc in a worksheet:
  • 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.


Getting started
  • A new workbook
  • Add a UserForm name = UserForm1


Paste the following code in sheet1:

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


In the userform module

Paste the following code:


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

Related :

This document entitled « VBA: Finding Hdc in an Excel worksheet or UserForm » from CCM (ccm.net) is made available under the Creative Commons license. You can copy, modify copies of this page, under the conditions stipulated by the license, as this note appears clearly.