「Excelで長門有希」を見た

Excelで長門有希@YouTubeを見た。
Excel VBAを使って、セルごとに色をつけることを行っているっぽい。にゃるほど。

とりあえず作ってみた：
*1
2007/12/13 差し替え。

Excel VBAは、とてもとてもやってられないことが分かった。文法といい記号といいエディタといい、いろいろときしょい。
MSDNにはリファレンスがあるんだろうか。それなりに探したが、見つけることすらできなかった。
24bitのビットマップしか展開できないのは仕様。32bitならほとんど同様にすれば出来るけど、8bitとかになってくるとVBAでどう扱ってよいものかわかんない。
また、どういう事情か分からないが、画像が大きいと（300px * 300pxでも危険）塗り替えの途中で「アプリケーション定義またはオブジェクト定義のエラー」を吐いて止まる。６万５千行くらいは出来るもんだと思ってたんだけどな。

一応ソース張っておく。

Sub OpenBitmap()
    Dim fileName As String
    Dim byteBuf As Byte
    
    Dim width As Long
    Dim height As Long
    
    Dim fileSize As Long
    Dim fileOffset As Long
    Dim fileType As Integer
    
    Dim r_color As Byte
    Dim g_color As Byte
    Dim b_color As Byte
    
    Dim padding As Byte
    
    fileName = "ここにファイル名を入れるだ"
    
    
    Open fileName For Binary Access Read As #1
    
    ' Check if the File is a bitmap file
    ' First Two Bytes are : B(66) , M(77)
    Get #1, , byteBuf
    If byteBuf <> 66 Then
        Return
    End If
    Get #1, , byteBuf
    If byteBuf <> 77 Then
        Return
    End If
    
    ' File Size; Just in case
    Get #1, , fileSize
    
    ' first Long is not required
    Get #1, , fileOffset
    ' second Long means fileOffset
    Get #1, , fileOffset
    
    ' first Long is not required
    Get #1, , width
    ' get width
    Get #1, , width
    ' get height
    Get #1, , height
    
    Get #1, , byteBuf
    Get #1, , byteBuf
    ' file type; 32? 24? 16? 8? etc...
    Get #1, , fileType
    
    ' Read till the file body
    For i = 31 To fileOffset
        Get #1, , byteBuf
    Next i
    MsgBox fileSize
    MsgBox fileOffset
    MsgBox width
    MsgBox height
    MsgBox fileType
    
    With ActiveSheet
    
        If fileType = 24 Then
            For h = 1 To height
                For w = 1 To width
                    Get #1, , b_color
                    Get #1, , g_color
                    Get #1, , r_color
                    .Cells(height - h + 1, w).Interior.Color = RGB(r_color, g_color, b_color)
                Next w
                padding = width Mod 4
                For p = 1 To padding
                    Get #1, , byteBuf
                Next p
            Next h
        End If
    End With
    
    Close #1
End Sub

2007/12/13 すーじー追記
Excel2003だと色が限定されます。24bitのきれいな色はちゃんと残りません。
また2003では行数は6.5万以上ありますが、列数は256しかなく、それ以上の値を指定すると止まります。
2003を使うなら、画像サイズは横256px以内でお願いします。

*1:画像は、ボアダムキラーズ ディレイレインのトップページ画像。一般向け同人ゲーム。いろいろと質が高い。おすすめ。激無断ですごめんなさい。要請がありましたら削除します。