Excelで画像処理 その1

　ExcelでBitmap画像のヒストグラムを調べるプログラムを作りました。

　Bitmapの読み込みは"もう一度、ExcelでBitmap"のソースコードを使っています。画像処理をするための布石です。

　ソースコードは、ご自由にご利用ください。ただし、趣味のプログラムなので、保証はありません。


Option Explicit

Public Sub histogram()
    '------------------------------
    Dim shp As Shape
    For Each shp In Sheet1.Shapes
        shp.Delete
    Next
 
    Sheet1.Cells.Delete
 
    '------------------------------
    Dim filename As String
 
    'filename = ThisWorkbook.Path + "\test.bmp"
    filename = Application.GetOpenFilename("Bitmap, *.bmp")
    If filename = "False" Then Exit Sub
 
    '------------------------------
    Dim data() As Byte
    Dim width As Long
    Dim height As Long
 
    Dim i As Long
    Dim j As Long
    Dim lineSize As Long
    Dim pos As Long
 
    Dim hr(255) As Long
    Dim hg(255) As Long
    Dim hb(255) As Long
 
    readBitmap filename, data, width, height
 
    lineSize = 3 * width + width Mod 4
 
    For i = 0 To 255
        hr(i) = 0
        hg(i) = 0
        hb(i) = 0
    Next i
 
    For i = 0 To height - 1
        For j = 0 To width - 1
            pos = lineSize * i + j * 3
         
            hb(data(pos + 0)) = hb(data(pos + 0)) + 1
            hg(data(pos + 1)) = hg(data(pos + 1)) + 1
            hr(data(pos + 2)) = hr(data(pos + 2)) + 1
        Next j
    Next i
 
    '------------------------------
    Sheet1.Cells(1, 1) = "Input File"
    Sheet1.Cells(1, 2) = filename
 
    '------------------------------
    Sheet1.Cells(2, 1) = "width"
    Sheet1.Cells(3, 1) = "height"
    Sheet1.Cells(2, 2) = width
    Sheet1.Cells(3, 2) = height
 
    '------------------------------
    Sheet1.Cells(5, 1) = "Input Image"
    Sheet1.Cells(6, 1).Select
 
    Set shp = Sheet1.Shapes.AddPicture(filename, msoFalse, msoTrue, Selection.Left, Selection.Top, 0, 0)
    shp.ScaleWidth 1, msoTrue
    shp.ScaleHeight 1, msoTrue
    shp.width = shp.width * 200 / shp.height
    shp.height = 200
 
    '------------------------------
    Sheet1.Cells(22, 1) = "Histogram"
    Sheet1.Cells(22, 2) = "r"
    Sheet1.Cells(22, 3) = "g"
    Sheet1.Cells(22, 4) = "b"
 
    For i = LBound(hr) To UBound(hr)
        Sheet1.Cells(23 + i, 1) = i
        Sheet1.Cells(23 + i, 2) = hr(i)
        Sheet1.Cells(23 + i, 3) = hg(i)
        Sheet1.Cells(23 + i, 4) = hb(i)
    Next i
 
    '------------------------------
End Sub