VBA: Βρίσκοντας Hdc σε ένα φύλλο εργασίας του Excel ή UserForm

Εδώ είναι δύο μικρά παραδείγματα για το πώς να βρείτε το Hdc σε ένα φύλλο εργασίας:

• Κάνοντας κλικ στο Φύλλο1 εμφανίζεται το UserForm.
• Τοποθετήστε το δείκτη στο UF, κρατήστε πατημένο το αριστερό πλήκτρο του ποντικιού και σύρετε το ποντίκι.
• Κλείνοντας το υποσύστημα UF συνεχίζεται και σχεδιάζει ένα τόξο στο φύλλο.

Ξεκινώντας

• Ένα νέο βιβλίο εργασίας
• Προσθέστε ένα όνομα χρήστη = UserForm1

Επικολλήστε τον ακόλουθο κώδικα στο φύλλο1:

 Ιδιωτική Δηλώστε Λειτουργία Arc Lib "gdi32" (ByVal hdc όσο Long, ByVal X1 όσο Long, ByVal Y1 όσο Long, ByVal X2 όσο Long, ByVal Y2 όσο Long,
ByVal X3 τόσο μακρύ, ByVal Y3 όσο μακρύς, ByVal X4 τόσο μακρύς, ByVal Y4 όσο μακρύς) όσο καιρό
Ιδιωτική Δηλώστε Λειτουργία ArcTo Lib "gdi32" (ByVal hdc ως μακρύς, ByVal X1 τόσο μακρύς, ByVal Y1 τόσο μακρύς, ByVal X2 όσο μακρύς, ByVal Y2 όσο μακρύς,
ByVal X3 τόσο μακρύ, ByVal Y3 όσο μακρύς, ByVal X4 τόσο μακρύς, ByVal Y4 όσο μακρύς) όσο καιρό
Προσωπικό φύλλο εργασίας Sub_SelectionChange (στόχος ByVal ως εύρος)
Dim B Για όσο καιρό
'ενεργοποιήστε ένα UC και τραβήξτε πάνω του (βρείτε το HDC σας)
UserForm1.Show
'Εύρεση του HDC σας στο φύλλο εργασίας του Excel
monhdc = 0
Κάντε Ενώ myhdc = 0
myhdc = GetForegroundWindow ()
B = myhdc
myhdc = GetDC (myhdc)
Βρόχος
'Σχεδιάστε απευθείας στο φύλλο εργασίας
Β = τόξο (myhdc, 120, 500, 320, 400, 320, 400, 780, 500)
End Sub 

Στη μονάδα χρήστη

Επικολλήστε τον ακόλουθο κώδικα:

 Ιδιωτικός τύπος POINTAPI
X Όσο καιρό
Y όσο καιρό
Τύπος Τέλους
Ιδιωτική Διακήρυξη Λειτουργία DeleteObject Lib "gdi32" (ByVal hObject όσο Long) όσο καιρό
Ιδιωτική Δηλώστε Λειτουργία SelectObject Lib "gdi32" (ByVal hdc ως μακρύ, ByVal hObject όσο καιρό) όσο Long
Ιδιωτική Δηλώστε Λειτουργία GetForegroundWindow Lib "user32" () As Long
Ιδιωτική Δηλώστε τη λειτουργία CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor όσο Long)
Private Declare Λειτουργία LineTo Lib "gdi32" (ByVal hdc ως μακρύ, ByVal X ως μακρύ, ByVal Y όσο καιρό) όσο Long
Ιδιωτική Δηλώστε τη λειτουργία MoveToEx Lib "gdi32" (ByVal hdc As Long, _
ByVal X ως μακρύς, ByVal Y όσο καιρό, lpPoint ως οποιοδήποτε) όσο καιρό
Ιδιωτική Δηλώστε Λειτουργία GetDC Lib "user32" (ByVal hwnd As Long) όσο καιρό
Δημόσια Declare Λειτουργία SetPixelV Lib "gdi32" (ByVal hdc ως μακρύς, ByVal X τόσο μακρύς, ByVal Y τόσο μακρύς, ByVal crColor όσο το μήκος) Ως Byte
Ιδιωτικό monhdc As Long
Dim Buff As Boolean
Ιδιωτική υπο-χρήστηςForm_MouseDown (κουμπί ByVal ως ακέραιο, ByVal Shift ως ακέραιο, ByVal X ως ενιαίο, ByVal Y ως ενιαίο)
Buff = True
End Sub
Ιδιωτικός υπο-χρήστηςForm_MouseMove (κουμπί ByVal ως ακέραιο, ByVal μετατόπιση ως ακέραιο, ByVal X ως ενιαίο, ByVal Y ως ενιαίο)
Κάντε Ενώ myhdc = 0
myhdc = GetForegroundWindow ()
myhdc = GetDC (monhdc)
Βρόχος
Εάν το πλήκτρο 1 Έπειτα την έξοδο Sub
hRPen = CreatePen (PS_SOLID, 10, RGB (0, 255, 0))
DeleteObjectΕπιλογήObject (myhdc, hRPen)
Αν το Buff Then
MoveToEx myhdc, Χ * 1.32, Υ * 1.32, & Ηο
Buff = False
Τέλος εαν
LineTo myhdc, Χ * 1.32, Υ * 1.32
DoEvents
End Sub