VBAで2次元配列データからビットマップ(BMP)画像を生成する

ビットマップ(.bmp)画像は内部構造がシンプルで、一部のデータを除けば基本的にすべてがRGBデータで構成されています。この特性を活かし、VBAの処理だけでビットマップ画像をゼロから生成することが可能です。単独でこの機能を利用する機会は少ないものの、Windows APIを併用することで、スクリーンのRGB値を一括で取得できるため、画面キャプチャ機能を実装することができます。

BMP画像のファイル構造

ビットマップは大きく分けると「ヘッダー部」「データ部」の2つで構成されています。このとき、バイナリデータの先頭から54byte分のデータがヘッダー部となっており、ヘッダー部以降の全てのデータがデータ部となっています。ヘッダー部にはこのファイルがビットマップであることや、画像の高さや幅、色数などの情報が格納され、データ部には各ピクセルのRGB値が順に格納されています。

 
icon-edit ヘッダー部

VBAでヘッダー部を定義するためにはBITMAPFILEHEADER構造体およびBITMAPINFOHEADER構造体を用意します。Openステートメントの「For Binary」で開いたファイルにこれら構造体を書き込めばビットマップファイルのヘッダー部の定義ができます。(※上画像でいうHeaderとInfoHeader)

'ビットマップファイルヘッダ構造体
Private Type BITMAPFILEHEADER
    bfType As String * 2        'ファイルタイプ ("BM")
    bfSize As Long              'ファイル全体のサイズ(ヘッダー部サイズ+データ部サイズ)
    bfReserved1 As Integer      '予約領域(※常に0)
    bfReserved2 As Integer      '予約領域(※常に0)
    bfOffBits As Long           'データ部の開始位置(ヘッダー部サイズ=54)
End Type

'ビットマップ情報ヘッダ構造体
Private Type BITMAPINFOHEADER
    biSize As Long              'この構造体のサイズ
    biWidth As Long             '画像の幅
    biHeight As Long            '画像の高さ
    biPlanes As Integer         '平面数 (※常に1)
    biBitCount As Integer       'ピクセルあたりのビット数(色深度))
    biCompression As Long       '圧縮形式
    biSizeImage As Long         '圧縮画像データサイズ
    biXPelsPerMeter As Long     '水平方向の解像度
    biYPelsPerMeter As Long     '垂直方向の解像度
    biClrUsed As Long           '使用される色数
    biClrImportant As Long      '重要な色数 (基本は0)
End Type

 
icon-edit データ部

VBAでデータ部を定義するためにRGBTRIPLE構造体を用意します。Openステートメントの「For Binary」で開いたファイルに対して前項のヘッダー情報を書き込んだ後にこの構造体の配列を入力することで、ビットマップファイルのデータ部の定義ができます。(※上画像でいうColorTable)

'色情報
Private Type RGBTRIPLE
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
End Type

データ部の色情報は画像の上下が反転されるため、ファイル書き込み時には注意する必要があります。また、画像の各行のRGBデータは4byteの倍数(32ビットの境界)とする必要があります。たとえば 画像幅が5ピクセルの場合は15byte(=RGBの3byte×5ピクセル)となりますがこれは4の倍数に1byte分不足しているため、その部分には空の1Byteデータを入力して境界を調整する必要があります。これを行わないとピクセル情報に"ズレ"が発生してしまい正しくビットマップを表現することができません
 

BMP画像生成コード

コード内でRGBTRIPLE構造体の配列データからビットマップ画像を生成するサンプルコードは下記のとおりです。出力パスを任意のパスに設定した後、下記コードを実行すると  のような2×2ピクセルのビットマップ画像を出力することができます。(※同名ファイルが存在する場合は上書き)

Option Explicit

'ビットマップファイルヘッダ構造体
Private Type BITMAPFILEHEADER
    bfType As String * 2        'ファイルタイプ ("BM")
    bfSize As Long              'ファイル全体のサイズ(ヘッダー部サイズ+データ部サイズ)
    bfReserved1 As Integer      '予約領域(※常に0)
    bfReserved2 As Integer      '予約領域(※常に0)
    bfOffBits As Long           'データ部の開始位置(ヘッダー部サイズ=54)
End Type

'ビットマップ情報ヘッダ構造体
Private Type BITMAPINFOHEADER
    biSize As Long              'この構造体のサイズ
    biWidth As Long             '画像の幅
    biHeight As Long            '画像の高さ
    biPlanes As Integer         '平面数 (※常に1)
    biBitCount As Integer       'ピクセルあたりのビット数(色深度))
    biCompression As Long       '圧縮形式
    biSizeImage As Long         '圧縮画像データサイズ
    biXPelsPerMeter As Long     '水平方向の解像度
    biYPelsPerMeter As Long     '垂直方向の解像度
    biClrUsed As Long           '使用される色数
    biClrImportant As Long      '重要な色数 (基本は0)
End Type

'色情報
Private Type RGBTRIPLE
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
End Type

'-----------------------------------------------------------------------
'-  メイン処理
'-----------------------------------------------------------------------
Sub main()

    Dim rgbImgData() As RGBTRIPLE
    Dim sPath As String
    
    '出力パス定義
    sPath = "C:\Users\...\sample.bmp"
    
    '画像サイズを定義 (2x2) ※配列は0始まり
    ReDim rgbImgData(1, 1) As RGBTRIPLE
    
    '左上ピクセル
    With rgbImgData(0, 0)
        .rgbRed = 255
        .rgbGreen = 0
        .rgbBlue = 0
    End With
    
    '右上ピクセル
    With rgbImgData(0, 1)
        .rgbRed = 0
        .rgbGreen = 255
        .rgbBlue = 0
    End With
    
    '左下ピクセル
    With rgbImgData(1, 0)
        .rgbRed = 0
        .rgbGreen = 0
        .rgbBlue = 255
    End With
    
    '右下ピクセル
    With rgbImgData(1, 1)
        .rgbRed = 255
        .rgbGreen = 255
        .rgbBlue = 0
    End With
    
    'ビットマップ出力
    Call ExportBitmap(sPath, rgbImgData)

End Sub

'-----------------------------------------------------------------------
'-  ビットマップ出力
'-----------------------------------------------------------------------
Private Sub ExportBitmap(sFilePath As String, rgbData() As RGBTRIPLE)

    Dim oFSO As Object
    Dim tBFHData As BITMAPFILEHEADER
    Dim tBIHData As BITMAPINFOHEADER
    Dim lWidth As Long
    Dim lHeight As Long
    Dim lFileNumber As Long
    Dim i As Long
    Dim j As Long
    Dim n As Long
    Dim bTmp As Byte

    '既に同名ファイルが存在していたら削除
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    If oFSO.FileExists(sFilePath) Then
        Call oFSO.DeleteFile(sFilePath)
    End If
    Set oFSO = Nothing

    'ビットマップ情報の定義
    lHeight = UBound(rgbData, 1) + 1
    lWidth = UBound(rgbData, 2) + 1
    n = (4 - (lWidth * 3 Mod 4)) Mod 4

    'ヘッダー部定義
    With tBFHData
        .bfType = "BM"
        .bfSize = Len(tBFHData) + Len(tBIHData) + 3 * lHeight * lWidth
        .bfOffBits = Len(tBFHData) + Len(tBIHData)
    End With
    With tBIHData
        .biSize = Len(tBIHData)
        .biWidth = lWidth
        .biHeight = lHeight
        .biPlanes = 1
        .biBitCount = 24
        .biCompression = 0
        .biSizeImage = 3 * lHeight * lWidth
        .biXPelsPerMeter = 3780
        .biYPelsPerMeter = 3780
        .biClrUsed = 0
        .biClrImportant = 0
    End With

    'ビットマップ出力
    lFileNumber = FreeFile()
    Open sFilePath For Binary As lFileNumber

        'ヘッダー部出力
        Put lFileNumber, , tBFHData
        Put lFileNumber, , tBIHData

        'データ部出力
        For i = lHeight - 1 To 0 Step -1
            For j = 0 To lWidth - 1
                Put lFileNumber, , rgbData(i, j)
            Next
            For j = 1 To n
                Put lFileNumber, , bTmp
            Next
        Next
    Close lFileNumber

End Sub

コード解説

ビットマップの色定義

ピクセルの色情報はRGBTRIPLE型のrgbImgData配列で定義されているため、配列の要素数を増やして各要素のRGB値を設定しておけば任意の画像を生成することができます。rgbImgData配列は2次元配列になっており、各要素のRGB値を適用するピクセルは下図の通り左上から順に設定していきます。

これにより i 行 j 列目のピクセルの色を指定したい場合は rgbImgData(i,j) のRGB要素を設定するだけでビットマップの色指定が行えます。ビットマップの色情報をこのようなRGB情報を持った構造体の2次元配列データとしておくことで、指定のピクセルの色情報へ簡単にアクセスすることができ、出力だけでなくグレースケール化や画像の回転などの画像処理も簡単に行うことができるようになります。
 

ビットマップ出力

ビットマップを出力するには下記の手順を行います。

① ヘッダー部の定義 (BITMAPFILEHEADER/BITMAPINFOHEADER構造体の定義)
② Openステートメントの「For Binary」でヘッダー部、データ部の順に書き出し

 
ヘッダー部の情報は基本的にはすべて定数値になるため、下記の通り記載しておけば問題ありません。画像の幅と高さの情報は前項で定義した2次元配列の要素数から取得することができます。

    Dim tBFHData As BITMAPFILEHEADER
    Dim tBIHData As BITMAPINFOHEADER

    lHeight = UBound(rgbImgData, 1) + 1 
    lWidth = UBound(rgbImgData, 2) + 1

    With tBFHData
        .bfType = "BM"
        .bfSize = Len(tBFHData) + Len(tBIHData) + 3 * lHeight * lWidth
        .bfOffBits = Len(tBFHData) + Len(tBIHData)
    End With
    With tBIHData
        .biSize = Len(tBIHData)
        .biWidth = lWidth
        .biHeight = lHeight
        .biPlanes = 1
        .biBitCount = 24
        .biCompression = 0
        .biSizeImage = 3 * lHeight * lWidth
        .biXPelsPerMeter = 3780
        .biYPelsPerMeter = 3780
        .biClrUsed = 0
        .biClrImportant = 0
    End With

 
ヘッダー部の定義ができたらOpenステートメントでバイナリファイルを作成し、先行してヘッダー部を出力します。その後、前項で定義した2次元配列の各要素を順に出力していきます。このときビットマップの構造上、画像の上下を反転させるために行の出力順は反転させる必要があります。また、行のバイト数が4の倍数となるように空のByteを入力する処理も入れる必要があります。

    'ビットマップ出力
    n = (4 - (lWidth * 3 Mod 4)) Mod 4
    lFileNumber = FreeFile()
    Open sFilePath For Binary As lFileNumber

        'ヘッダー部出力
        Put lFileNumber, , tBFHData
        Put lFileNumber, , tBIHData

        'データ部出力
        For i = lHeight - 1 To 0 Step -1

            'RGB値出力
            For j = 0 To lWidth - 1
                Put lFileNumber, , rgbData(i, j)
            Next

            '4バイト倍数調整用
            For j = 1 To n
                Put lFileNumber, , bTmp  
            Next
        Next
    Close lFileNumber

関連情報

icon-share-square VBA×画像処理ページ

VBAでBMP画像を読み込みExcel上でドット絵を作成する方法

icon-share-square 参考

外部リンク:【バイナリエディタ】BMP画像のファイル構造を解析

Excel,VBA,画像処理