' 標準モジュールに追加
Declare PtrSafe Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As Long
Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long) As Long
Declare PtrSafe Function GetWindowDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
Type POINTAPI
x As Long
y As Long
End Type
Sub GetMousePositionColor()
Dim pt As POINTAPI
Dim wst As Worksheet
Dim lngColor As Long
Dim lngRowOutput As Long
Dim hdc As LongPtr
Dim strRGB As String
' マウスの現在位置を取得
GetCursorPos pt
' デスクトップのデバイスコンテキストを取得
hdc = GetWindowDC(0&)
' マウスの位置にある色を取得
lngColor = GetPixel(hdc, pt.x, pt.y)
' RGB値をメッセージボックスに表示
strRGB = "RGB(" & lngColor Mod 256 & ", " & (lngColor \ 256) Mod 256 & ", " & (lngColor \ 65536) Mod 256 & ")"
Set wst = Worksheets("色取得")
lngRowOutput = wst.Range("A1").CurrentRegion.Rows.Count + 1
wst.Range("A" & lngRowOutput).Value = strRGB
' デバイスコンテキストの解放
ReleaseDC 0&, hdc
End Sub
コメント