2013-05-13 29 views
5

W języku VBA, w jaki sposób mogę odczytać wartość koloru każdego piksela obrazu?Czytanie kolorów pikseli obrazu

Znalazłem this solution w VB 6.0, ale nie stosuje się bezpośrednio w VBA.

+1

jeśli kod korzysta z API, to raczej możliwe jest zaimplementowanie go w ustawieniu VBA niektóre odwołania do funkcji API ... –

+0

Jaki typ pliku pytasz? Jakieś w szczególności? Może lista typów plików? Różne formaty plików będą inaczej przechowywać informacje o kolorach, więc odczytywanie różnych typów będzie wymagało znajomości tego, co będziemy musieli przeczytać. – jhoe

+0

Poniższa odpowiedź działa świetnie, ale jeśli chcesz zeskanować każdy piksel (zamiast go kliknąć), to https://stackoverflow.com/questions/45998565/scan-image-pixel-by-pixel-in-vba/ 46004570 # 46004570 wykonuje pracę ładnie i wszystko w VBA (bez bibliotek graficznych itp.) – perfo

Odpowiedz

6

Spróbuj rozwiązanie zamieszczonych na tej stronie tutaj: http://sim0n.wordpress.com/2009/03/27/vba-q-how-to-get-pixel-colour/

musiałem zmienić ByRef Do ByVal ale poza tym działa dobrze. Wstaw zdjęcie za pomocą Wstaw> Obrazek i przypisz makro do zdarzenia po kliknięciu. Właśnie ustawiłem kolor komórki A1 na kolor, który kliknąłeś, ale jestem pewien, że wpadłeś na ten pomysł.

#If VBA7 Then 
    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 GetCursorPos Lib "user32" (ByRef lpPoint As POINT) As LongPtr 
    Private Declare PtrSafe Function GetWindowDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr 
#Else 
    Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long,  ByVal y As Long) As Long 
    Private Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINT) As Long 
    Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long 
#End If 
Private Type POINT 
    x As Long 
    y As Long 
End Type 

Sub Picture1_Click() 
    Dim pLocation As POINT 
    Dim lColour As Long 

    Dim lDC As Variant 
    lDC = GetWindowDC(0) 
    Call GetCursorPos(pLocation) 
    lColour = GetPixel(lDC, pLocation.x, pLocation.y) 
    Range("a1").Interior.Color = lColour 
End Sub 

Aby z niego skorzystać, umieść zdjęcie w arkuszu, kliknij obraz prawym przyciskiem myszy i przypisz do niego to makro.

+0

Świetna odpowiedź, przetestowana i działa idealnie. +1 – hammythepig

+1

To samo z dodatkowymi informacjami: możesz również użyć obrazów, które po prostu wklejasz do arkusza (procedura "Wstaw> Obraz" nie jest obowiązkowa). Jeszcze raz dziękuję +1 i dziękuję @KM Hs – Arthur