Option Explicit

Private Type typHeader
     Tipo As String * 2
     Tamanho As Long
     res1 As Integer
     res2 As Integer
     Offset As Long
End Type

Private Type typInfoHeader
     Tamanho As Long
     Largura As Long
     Altura As Long
     Planes As Integer
     Bits As Integer
     Compression As Long
     ImageSize As Long
     xResolution As Long
     yResolution As Long
     nColors As Long
     ImportantColors As Long
End Type

Private Type typePixel
     b As Byte
     g As Byte
     r As Byte
End Type

Sub Desenho()

     Dim bmpHeader As typHeader
     Dim bmpInfoHeader As typInfoHeader
     Dim bmpPixel As typePixel
      
     Dim nCnt As Long
     Dim nRow As Integer, nCol As Integer
     Dim nRowBytes As Long
      
     Dim fBMP As String
      
     Worksheets(1).Activate
     Columns("A:IV").Delete
      
     fBMP = Workbooks(1).Path & "\" & "Sample.BMP"
      
     Open fBMP For Binary Access Read As 1 Len = 1
      
         Get 1, 1, bmpHeader
          
         If bmpHeader.Tipo <> "BM" Then
             MsgBox "Not a bitmap file.", vbCritical, "Error"
             End
         End If
          
         Get 1, , bmpInfoHeader
          
         If bmpInfoHeader.Bits <> 24 Then
             MsgBox "Sorry, only 24-bits BMP files can be converted.", vbCritical, "Error"
             End
         End If
         If bmpInfoHeader.Compression <> 0 Then
             MsgBox "Sorry, only uncompressed BMP files can be converted.", vbCritical, "Error"
             End
         End If
         If bmpInfoHeader.Largura > 255 Or bmpInfoHeader.Altura > 1000 Then
             MsgBox "Image is " & bmpInfoHeader.Largura & " x " & _
                 bmpInfoHeader.Altura & " pixels." & vbCrLf & _
                 "Maximum size is 255 x 1000.", vbCritical, "Error"
             End
         End If
          
         Rows("1:" & bmpInfoHeader.Altura).RowHeight = 2
         nRowBytes = bmpInfoHeader.Largura * 3
         If nRowBytes Mod 4 <> 0 Then
             nRowBytes = nRowBytes + (4 - nRowBytes Mod 4)
         End If
          
         'Start actual conversion, reading each pixel...
         For nRow = 0 To bmpInfoHeader.Altura - 1
             'Rows(nRow).RowHeight = 2
             For nCol = 0 To bmpInfoHeader.Largura - 1
                 If nRow = 0 Then
                     Columns(nCol + 1).ColumnWidth = 0.17
                 End If
                 Get 1, bmpHeader.Offset + 1 + nRow * nRowBytes + nCol * 3, bmpPixel
                 'Get 1, , bmpPixel
                 Cells(bmpInfoHeader.Altura - nRow, nCol + 1).Interior.Color = RGB(bmpPixel.r, bmpPixel.g, bmpPixel.b)
             Next
         Next
          
     Close
      
     Cells(1, 1).Select
      
     MsgBox "Image generated", , "Ready"

End Sub