如何使用excel vba从图片文件中读取像素？

Posted 2021-05-02

有谁知道，如何读取位图文件的每个像素？ 我想将r / g / b值写入Excel工作表。

我寻找类似的东西

my_picture = LoadThePicture('alf.txt')
for y = 0 to my_picture.Height()
  for x = 0 to my_picture.Width()
    red = my_picture.GetPixel(x,y).Red 

AM2

答案

我认为代码看起来应该是这样的（BMP，24位RGB颜色，没有颜色空间信息）：

Option Explicit

Type typHEADER
    strType As String * 2  ' Signature of file = "BM"
    lngSize As Long        ' File size
    intRes1 As Integer     ' reserved = 0
    intRes2 As Integer     ' reserved = 0
    lngOffset As Long      ' offset to the bitmap data (bits)
End Type

Type typINFOHEADER
    lngSize As Long        ' Size
    lngWidth As Long       ' Height
    lngHeight As Long      ' Length
    intPlanes As Integer   ' Number of image planes in file
    intBits As Integer     ' Number of bits per pixel
    lngCompression As Long ' Compression type (set to zero)
    lngImageSize As Long   ' Image size (bytes, set to zero)
    lngxResolution As Long ' Device resolution (set to zero)
    lngyResolution As Long ' Device resolution (set to zero)
    lngColorCount As Long  ' Number of colors (set to zero for 24 bits)
    lngImportantColors As Long ' "Important" colors (set to zero)
End Type

Type typBITMAPFILE
    bmfh As typHEADER
    bmfi As typINFOHEADER
    bmbits() As Byte
End Type

Type typPicture
    Height As Integer
    Width As Integer
    Red() As Byte
    Green() As Byte
    Blue() As Byte
End Type

Function LoadThePicture(bmpFileName As String) As typPicture
    Dim bmpFile As typBITMAPFILE
    Dim pict As typPicture
    Open bmpFileName For Binary As #1
    'Read_headers
    Get #1, , bmpFile.bmfh
    Get #1, , bmpFile.bmfi

    Dim lngRowSize, lngPixelArraySize As Long
    Dim Rows, Cols, pad4 As Integer
    Rows = bmpFile.bmfi.lngHeight
    Cols = bmpFile.bmfi.lngWidth
    pict.Height = Rows
    pict.Width = Cols
    ReDim pict.Red(1 To Rows, 1 To Cols)
    ReDim pict.Green(1 To Rows, 1 To Cols)
    ReDim pict.Blue(1 To Rows, 1 To Cols)

    lngRowSize = ceil(bmpFile.bmfi.intBits * bmpFile.bmfi.lngWidth / 32) * 4
    pad4 = lngRowSize - Fix(bmpFile.bmfi.intBits * bmpFile.bmfi.lngWidth / 32 * 4) ' how much to pad to 4 bytes group
    lngPixelArraySize = lngRowSize * bmpFile.bmfi.lngHeight
    ReDim bmpFile.bmbits(1 To lngPixelArraySize)
    Get #1, , bmpFile.bmbits
    Close #1

    Dim row, col, k, l As Integer
    k = 0
    For row = Rows To 1 Step -1
        For col = 1 To Cols
            pict.Blue(row, col) = bmpFile.bmbits(k + 1)
            pict.Green(row, col) = bmpFile.bmbits(k + 2)
            pict.Red(row, col) = bmpFile.bmbits(k + 3)
            k = k + 3
        Next col
        k = k + pad4 ' skip padding
    Next row
End Function

我找不到现成的解决方案，恕我直言，你需要自己编写代码的另一种类型的文件