2013-03-04 186 views
4

我正在研究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-436428d9586bVBA手動創建BMP

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 
+1

您是否看到與24 x 24 bmp相同的效果?我懷疑每行字節對齊問題,並且24x24不應該受到它的影響。 – 2013-03-05 00:36:46

+0

謝謝,我認爲這是問題所在。如果我在進入循環之前設置k = -1,則所有內容都正確排列。謝謝你的幫助。 – DasPete 2013-03-05 22:02:24

回答

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,...)

我假設您不再需要此代碼,但我從此處複製它我想其他人也會。

0

要使「天花板」功能正確(VBA/excel 2007),不需要「精確」語句。
宏正在正常工作:

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

我運行了你的代碼來驗證黃線。仔細觀察後,我相信問題可以通過設置bmpfile.bmpbits字節數組的邊界來解決。當你定義的數組你離開下界空,因此該數組默認會從0開始。如果重新變暗這樣

ReDim .bmbits(1 To lngPixelArraySize) 

你會得到一個純白色sample.bmp數組。我跑它來驗證,它爲我工作。

祝你好運。我可以看到如何使k從-1開始工作。剩下的唯一問題是您的數組大小將會有一個額外的字節。