VBA手动创建BMP

Question

我正在研究VBA类来创建QR码，并且我很难将QR数据位写入实际BMP文件。为了获得BMP结构和代码的悬挂，我可以使用下面的代码尝试制作全部为白色的21 x 21像素位图。这几乎行得通，除了每行中最左边的列是黄色而不是白色。关于可能发生什么的任何想法？我猜测我的头文件定义有问题，但我不确定。我离BMPs很远。我的代码是基于关闭什么我发现这里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

这是连续字节对齐问题。用一个额外的字节填充每行，你的问题应该消失。

发布以便您有一个解决的答案。 :)

此外，这是一个很好的bmp工具。 https://50ab6472f92ea10153000096.openlearningapps.net/run/view

Answer 2

此BMP导出代码中存在一个小错误。
，说

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

实际上应该说

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

，之前的一轮功能无法正常出口阻碍了特定图像的宽度，并且代码抛出错误的行。先前被拒绝的宽度：（3,6,7,11,14,15,19,22,23,27,30，...）

我假设您不再需要此代码，但我从此处复制它我想其他人也会。

Answer 3

要使“天花板”功能正确（VBA/excel 2007），不需要“精确”语句。
宏正在正常工作：

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

Answer 4

我运行了你的代码来验证黄线。仔细观察后，我相信问题可以通过设置bmpfile.bmpbits字节数组的边界来解决。当你定义的数组你离开下界空，因此该数组默认会从0开始。如果重新变暗这样

ReDim .bmbits(1 To lngPixelArraySize) 

你会得到一个纯白色sample.bmp数组。我跑它来验证，它为我工作。

祝你好运。我可以看到如何使k从-1开始工作。剩下的唯一问题是您的数组大小将会有一个额外的字节。