Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long) As Long
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As rect) As Long
#Else
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As rect) As Long
#End If
Type rect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Sub ObtenirCouleurPixelImage()
Dim shp As Shape
Dim hdc As LongPtr
Dim couleur As Long
Dim x As Long, y As Long
Dim rect As rect
Dim hwnd As LongPtr
' Obtenir le handle de la fenêtre Excel
hwnd = Application.hwnd
' Obtenir les coordonnées de la fenêtre Excel
GetWindowRect hwnd, rect
' Remplacez "NomDeLaForme" par le nom de votre forme
Set shp = ActiveSheet.Shapes("NomDeLaForme")
' Coordonnées relatives du pixel à l'intérieur de la forme (par exemple, 10 pixels à droite et 20 pixels en bas du coin supérieur gauche)
Dim xRelatif As Long, yRelatif As Long
xRelatif = 10
yRelatif = 20
' Convertir les coordonnées relatives en coordonnées absolues par rapport à la fenêtre Excel
x = rect.Left + shp.Left + xRelatif
y = rect.Top + shp.Top + yRelatif
' Obtenir le contexte de périphérique (Device Context)
hdc = GetDC(0)
' Obtenir la couleur du pixel
couleur = GetPixel(hdc, x, y)
' Libérer le contexte de périphérique
ReleaseDC 0, hdc
' Afficher la couleur
MsgBox "La couleur du pixel est : " & couleur
End Sub
