VBA manually creates BMP

Question

I am working on a VBA class to create QR codes, and I get stuck at the point where I write a bit of QR data to the actual BMP file. To get a view of the BMP structure and code, I could try making a 21 x 21 pixel bitmap in white using the code below. This almost works, except that the leftmost column in each row is yellow, not white. Any ideas on what could happen? I guess something is wrong with my header definition, but I'm not sure. I am far from a professional in BMP. My code is based on what I found here http://answers.microsoft.com/en-us/office/forum/office_2007-customize/how-can-i-create-a-bitmap-image-with-vba/ 4976480a-d20b-4b2a-8ecc-436428d9586b

Private 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 Private 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 Private Type typPIXEL bytB As Byte ' Blue bytG As Byte ' Green bytR As Byte ' Red End Type Private Type typBITMAPFILE bmfh As typHEADER bmfi As typINFOHEADER bmbits() As Byte End Type '================================================== Public Sub makeBMP(intQR() As Integer) Dim bmpFile As typBITMAPFILE Dim lngRowSize As Long Dim lngPixelArraySize As Long Dim lngFileSize As Long Dim j, k, l, x As Integer Dim bytRed, bytGreen, bytBlue As Integer Dim lngRGBColoer() As Long Dim strBMP As String With bmpFile With .bmfh .strType = "BM" .lngSize = 0 .intRes1 = 0 .intRes2 = 0 .lngOffset = 54 End With With .bmfi .lngSize = 40 .lngWidth = 21 .lngHeight = 21 .intPlanes = 1 .intBits = 24 .lngCompression = 0 .lngImageSize = 0 .lngxResolution = 0 .lngyResolution = 0 .lngColorCount = 0 .lngImportantColors = 0 End With lngRowSize = Round(.bmfi.intBits * .bmfi.lngWidth / 32) * 4 lngPixelArraySize = lngRowSize * .bmfi.lngHeight ReDim .bmbits(lngPixelArraySize) ReDim lngRGBColor(21, 21) For j = 1 To 21 ' For each row, starting at the bottom and working up... 'each column starting at the left For x = 1 To 21 k = k + 1 .bmbits(k) = 255 k = k + 1 .bmbits(k) = 255 k = k + 1 .bmbits(k) = 255 Next x If (21 * .bmfi.intBits / 8 < lngRowSize) Then ' Add padding if required For l = 21 * .bmfi.intBits / 8 + 1 To lngRowSize k = k + 1 .bmbits(k) = 0 Next l End If Next j .bmfh.lngSize = 14 + 40 + lngPixelArraySize End With ' Defining bmpFile strBMP = "C:\Desktop\Sample.BMP" Open strBMP For Binary Access Write As 1 Len = 1 Put 1, 1, bmpFile.bmfh Put 1, , bmpFile.bmfi Put 1, , bmpFile.bmbits Close End Sub 

Answer 1

This is a line alignment issue. Put each line with one extra byte and your problem will go away.

Sent so that you have a response to verification. :)

Also, here is a good bmp tool. https://50ab6472f92ea10153000096.openlearningapps.net/run/view

Answer 2

There is a small error in this BMP code.
the line that says

 lngRowSize = Round(.bmfi.intBits * .bmfi.lngWidth / 32) * 4 

gotta really say

 'old line: lngRowSize = Round(.bmfi.intBits * .bmfi.lngWidth / 32) * 4 lngRowSize = WorksheetFunction.Ceiling_Precise(.bmfi.intBits * .bmfi.lngWidth / 32) * 4 

Previously, the round function prevented the correct export of a certain image width, and the code returned an error. Previously rejected widths: (3,6,7,11,14,15,19,22,23,27,30, ...)

I assume that you no longer need this code, but I copied it here, and I believe that someone else will be.

Answer 3

I checked your code to check the yellow line. Having studied it carefully, I believe that the problem can be solved by setting the boundaries of your byte array bmpfile.bmpbits. When you defined the array, you left the bottom border empty, and so the default array will start at 0. If you again extinguish an array like this

  ReDim .bmbits(1 To lngPixelArraySize) 

You will get a solid white sample.bmp. I checked it to check and it worked for me.

Good luck. I could see how to get k to start with -1 to work. The only problem that remains is that your array size will contain one extra byte.

Answer 4

To properly perform the ceiling function (VBA / excel 2007), an exact statement is not required.
Macro works correctly:

 lngRowSize = WorksheetFunction.Ceiling(.bmfi.intBits * .bmfi.lngWidth / 32, 0.5) * 4