在VBA中逐像素扫描图像

这里有一个几乎完全相同的问题

Op实际上问了和我一样的问题。但是接受了一个接近但不完全的答案。。下面的代码（取自该线程）完成了我需要的所有操作，逐像素逐位地对其进行限制。如果你点击一张图片，它会在点击点给你颜色。因为我想扫描整个图片，我想我只需要做一个xy扫描，然后把顺序的X和Y放进去，而不是GetCursorPos调用返回的X和Y。但是如何获得左位置和宽度（例如）以像素为单位来开始扫描呢？我会在下一个循环中放入什么来处理每个像素

为了澄清我的问题。 如何更改下面的代码以扫描图像的每个像素，而不仅仅是单击的光标位置。谢谢

#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

---

perfo的答案非常棒，而且很有效

以下是一些有帮助的注意事项：

必须将图像添加为ActiveX控件（请转到Excel Developer功能区以执行此操作，然后右键单击图像并将其名称设置为Image1-这应该是默认设置）

另外，确保它位于VBA中名为Sheet1的图纸上（同样，这应该是默认值）

该例程返回RGBA颜色。我创建了以下例程为每个单元格着色：

Sub ColourCell(c As Range, ThisColour As Single)

'colour the passed in range

Dim Red As Byte
Dim Green As Byte
Dim Blue As Byte

Red = ThisColour And &HFF&
Green = (ThisColour And &HFF00&) / 256
Blue = (ThisColour And &HFF0000) / 65535

c.Interior.Color = RGB(Red, Green, Blue)

End Sub

我修改了答案，将活动单元格中的单元格向下和横向着色，如下所示：

'*** scan image left to right top to bottom ****
Dim i As Integer
Dim j As Integer

Dim OriginalRowNumber As Integer
Dim OriginalColumnNumber As Integer

OriginalRowNumber = ActiveCell.Row
OriginalColumnNumber = ActiveCell.Column

i = OriginalRowNumber
j = OriginalColumnNumber

Sheet1.Select

Cells.EntireColumn.ColumnWidth = 0.63
Cells.EntireRow.RowHeight = 6

For ScanX = RC.Left To RC.Right
  For ScanY = RC.Top To RC.Bottom
    PixCol = GetPixel(IDC, ScanX, ScanY)
    ColourCell Cells(j, i), PixCol
    j = j + 1
    
  Next
  i = i + 1
  
  If i Mod 5 = 0 Then Stop
  
  j = OriginalColumnNumber
  
Next

---

其中有两个额外的位用于设置微小的网格大小，因此您可以看到图片正在展开，还有一个调试行用于每隔5列暂停宏（运行需要很长时间）。

您的问题实际上是关于映射坐标系。这绝对与读取像素无关。如果这个问题能被恰当地抽象出来的话，它会更有用。谢谢你的建设性意见。。然而，我可以指出，如果你不知道答案，那么你可以说我不知道或者忽略这个问题。你不需要发表对人类或野兽毫无用处的评论。无正当理由地记下这个问题对stackoverflow的学习环境是不利的。我一点也不清楚你要找的屏幕坐标范围。我的目标是要有一个图像（可以是任何格式的BMP、JPEG等），我可以控制格式。在VBA中，我想扫描图片的每个像素，并提取每个像素的颜色信息。我上面提到的另一个线程通过将图像插入excel工作表并使用光标位置识别用户需要的像素来完成部分工作。我似乎可以找到如何找到图像左上角的像素，然后扫描整个图像。Image.left给了我Twips（我想）的坐标，但是我没有使用getpixcel（HDc，X，Y）的运气，因为这里的xy是以像素为单位的。对不起，我应该添加。在VBA中从图像中获取像素颜色是我的最终目标。不管怎样，我都非常愿意这样做。上面的代码似乎是我开始学习的好地方。谢谢DavidSo，上面的内容并不漂亮，但完全符合我的要求，并且在VBA中也符合我的要求。要测试它，只需在sheet1中插入一个活动的x图像，并确保它被称为image1，然后运行XYScanofImage例程？？这是我自己的问题，答案完全符合我的需要。如果你要做a-1，至少让我知道为什么。也许你的评论真的会帮助某人…嘿，伙计，谢谢你。它工作得很好。我也发现了这个，它使工作更快！不幸的是，只有将图像添加到图纸中时，此操作才有效。如果它是外部的呢？另一个警告（可能对其他人来说很明显，但我不太明白Windows调用是如何工作的）-如果在宏运行时尝试执行其他操作，它将在新屏幕上显示并切换它的绘图内容！

'*** scan image left to right top to bottom ****
Dim i As Integer
Dim j As Integer

Dim OriginalRowNumber As Integer
Dim OriginalColumnNumber As Integer

OriginalRowNumber = ActiveCell.Row
OriginalColumnNumber = ActiveCell.Column

i = OriginalRowNumber
j = OriginalColumnNumber

Sheet1.Select

Cells.EntireColumn.ColumnWidth = 0.63
Cells.EntireRow.RowHeight = 6

For ScanX = RC.Left To RC.Right
  For ScanY = RC.Top To RC.Bottom
    PixCol = GetPixel(IDC, ScanX, ScanY)
    ColourCell Cells(j, i), PixCol
    j = j + 1
    
  Next
  i = i + 1
  
  If i Mod 5 = 0 Then Stop
  
  j = OriginalColumnNumber
  
Next