title: VBA manually create BMP
body: <p>I am working on a VBA class to create QR codes and I am getting stumped at the point where I write the QR data bits to an actual BMP file. To get the hang of the BMP structure and the code I could I have been trying to make a 21 x 21 pixel bitmap of all white using the code below. This almost works, except that the leftmost column in every row is yellow instead of white. Any ideas on what could be happening? I'm guessing there is something wrong with my header definition, but I'm not sure. I am far from a pro at BMPs. My code is based off what I found here <a href="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" rel="nofollow">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</a></p>
  
  <pre><code>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 &lt; 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
  </code></pre>