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

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

1. BMP画像のファイル構造
2. BMP画像生成コード
3. コード解説
4. 関連情報

BMP画像のファイル構造

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

ヘッダー部

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

'ﾋﾞｯﾄﾏｯﾌﾟﾌｧｲﾙﾍｯﾀﾞ構造体

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

　
データ部

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


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

'色情報

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

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)

For j = 1 To n

Put lFileNumber, , bTmp

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

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