2013-05-13 184 views
5

在VBA中,如何读取图像中每个像素的颜色值?读取图像的像素颜色

我在VB 6.0中发现this solution,但它并不直接适用于VBA。

+1

如果代码使用API​​,那么它很可能实现它到VBA中,设置API函数的一些引用... – 2013-05-13 19:08:37

+0

你问什么文件类型?任何特别的?也许是一个文件类型的列表?不同的文件格式将存储不同的颜色信息,因此读取不同的类型将需要知道我们将需要阅读什么。 – jhoe 2013-06-03 22:13:18

+0

下面的答案很好,但如果你真的想扫描每个像素(而不是点击它),那么这个https://stackoverflow.com/questions/45998565/scan-image-pixel-by-pixel-in-vba/ 46004570#46004570很好地完成了这项工作,所有在VBA(没有图形库等) – perfo 2017-09-06 08:27:47

回答

6

尝试在网站上公布这里的解决方案: http://sim0n.wordpress.com/2009/03/27/vba-q-how-to-get-pixel-colour/

我不得不改变的ByRef到BYVAL但,除了它工作得很好。使用“插入”>“图片”插入图片,并为点击事件分配一个宏。我刚刚将单元格A1的颜色设置为您点击的颜色,但我相信您明白了。

#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 

要使用它,将图片放置在工作表中,右键单击图像并将其分配给它。

+0

伟大的答案,测试它,它完美的作品。 +1 – hammythepig 2013-06-20 20:09:49

+1

此处还有其他信息:您还可以使用只需粘贴在工作表中的图像(“插入>图片”过程不是强制性的)。再次感谢+1并感谢您@KM Hs – Arthur 2014-04-24 15:02:31