Vba画像素图

Vba画像素图 Sub Main() Const strBmpFile As String = "C:\1.bmp" Dim arrByte() As Byte Dim PixelCol As Long, PixelRow As Long Dim CellCol As Long, CellRow As Long Dim i As Long, j As Long Dim lngPos As Long, Zeroize As Long '获取bmp图片二进制数组 Open strBmpFile For Binary As #1 ReDim arrByte(LOF(1) - 1) Get #1, , arrByte Close #1 '获取图片的像素高和宽。宽度不是4的倍数时需补零 For i = 0 To 3 PixelCol = PixelCol + arrByte(i + 18) * 256 ^ i Next For i = 0 To 3 PixelRow = PixelRow + arrByte(i + 22) * 256 ^ i Next If PixelCol Mod 4 <> 0 Then Zeroize = PixelCol Mod 4 Cells.Clear For i = PixelRow To 1 Step -1 CellRow = CellRow + 1 CellCol = 0 For j = 1 To PixelCol * 3 Step 3 CellCol = CellCol + 1 lngPos = 53 + j + (i - 1) * (PixelCol * 3 + Zeroize) Cells(CellRow, CellCol).Interior.Color = RGB(arrByte(lngPos + 2), arrByte(lngPos + 1), arrByte(lngPos)) Next Next End Sub