テーブルタグをEXCELから書き出すマクロ


エクセル2003の、カラーインデックステーブルと、HTMLのTABLEタグ作成マクロ

エクセル2003の、カラーインデックステーブル

　EXCEL2007に触ってみて、セルや罫線、フォントのカラーが自由自在であることを知って、逆にEXCEL2003のセルの色が、そもそも何種類くらいあるのだろう？ということが気になって全部書き出してみました。EXCEL-VBAでRGB指定したとしても、ここにある色以外はどうも着けられないということも、分かりまして。
　カラーインデックスを1〜56まで選べるのですが、その中で、10組のダブりがあることも分かりました。実質46色になりますね。

カラーインデックス 色名
RGB

1 黒 53 茶 52 オリーブ 51 濃い緑 49 濃い青緑 11 濃い青 55 インディゴ 56 80%灰色
#000000 #993300 #333300 #003300 #003366 #000080 #333399 #333333
9 濃い赤 46 オレンジ 12 濃い黄　 10 緑 14 青緑 5 青 47 ブルーグレー 16 50%灰色
#800000 #FF6600 #808000 #008000 #008080 #0000FF #666699 #808080
3 赤 45 薄いオレンジ 43 ライム 50 シークグリーン 42 アクア 41 薄い青 13 紫 48 40%灰色
#FF0000 #FF9900 #99CC00 #339966 #33CCCC #3366FF #800080 #969696
7 ピンク 44 ゴールド 6 黄 4 明るい緑 8 水色 33 スカイブルー 54 プラム 15 25%灰色
#FF00FF #FFCC00 #FFFF00 #00FF00 #00FFFF #00CCFF #993366 #C0C0C0
38 ローズ 40 ベージュ 36 薄い黄 35 薄い緑 34 薄い水色 37 ペールブルー 39 ラベンダー 2 白
#FF99CC #FFCC99 #FFFF99 #CCFFCC #CCFFFF #99CCFF #CC99FF #FFFFFF
　
17 　 18 プラム 19 　 20 薄い水色 21 　 22 　 23 　 24 　
#9999FF #993366 #FFFFCC #CCFFFF #660066 #FF8080 #0066CC #CCCCFF
25 濃い青 26 ピンク 27 黄 28 水色 29 紫 30 濃い赤 31 青緑 32 青
#000080 #FF00FF #FFFF00 #00FFFF #800080 #800000 #008080 #0000FF
（背景が白のセルについてのみ、手動で{background-color:#FFFFFF"}を入れました）

HTMLのTABLEタグ作成マクロ

EXCELに作った表から、HTMLのTABLEタグを書き出すマクロ
抽出するデータは、

　EXCELで作成した表を、HTMLに書き出したい場合、セル範囲を選択しておいて、マクロを走らせることにより実行できたら楽だということで、ちょっと作ってみました。出力の方法はいろいろとアレンジできるのですが、一番シンプルに、“実行するとクリップボードにコピーされた”という状態での出力としました。あとは、メモ帳などのテキストエディタ上で貼り付けていただけば、テーブルタグが一つ丸ごと使えます。

Sub テーブルタグ_カラー()
'選択範囲のテーブルタグ（カラー）を書き出すためのマクロ
    Dim t(100,100) As String
    Dim a(100,100) As Long
    Dim b(100,100) As Long
    Dim s(100,100) As String
    Dim Style_Set As String

    x1 = Selection.Column
    y1 = Selection.Row
    x2 = x1+Selection.Columns.Count-1
    y2 = y1+Selection.Rows.Count-1


    For x = x1 To x2
    For y = y1 To y2
        ym = Cells(y,x).MergeArea.Row
        xm = Cells(y,x).MergeArea.Column

        Style_Set = ""
        '背景色白以外のときのスタイル
        If Cells(y,x).Interior.Color <> 16777215 Then
            Style_Set = Style_Set+"background-color:"+Colorset(Cells(y,x).Interior.Color)+";"
        End If
        '文字色が黒以外のときのスタイル
        If Cells(y,x).Font.Color <> 0 Then
            Style_Set = Style_Set+"color:"+Colorset(Cells(y,x).Font.Color)+";"
        End If
        '太字（ボールド）のときのスタイル
        If Cells(y,x).Font.Bold = True Then
            Style_Set = Style_Set+"font-weight:bold;"
        End If
        '斜体（イタリック）のときのスタイル
        If Cells(y,x).Font.Italic = True Then
            Style_Set = Style_Set+"font-style:italic;"
        End If

        If Style_Set <> "" Then Style_Set = " style="""+Style_Set+""""

        s(x-x1,y-y1) = Style_Set
        a(x-x1,y-y1) = -1
        If x = xm And y = ym Then
            t(x-x1,y-y1) = Cells(y,x).Text
            a(x-x1,y-y1) = 1
            b(x-x1,y-y1) = 1

        Else
            t(x-x1,y-y1) = ""
            If xm = x Then a(xm-x1,ym-y1) = a(xm-x1,ym-y1)+1
            If ym = y Then b(xm-x1,ym-y1) = b(xm-x1,ym-y1)+1
        End If

    Next y
    Next x

    xxx = xxx+"<table border=""1"" cellspacing=""0"" cellpadding=""2"" bordercolor=""black"">"+Chr(13)+Chr(10)

    For y = y1 To y2
        xxx = xxx+"<tr>"
    For x = x1 To x2
        If a(x-x1,y-y1) >= 0 Then
            xxx = xxx+"<td"
            If a(x-x1,y-y1) > 1 Then xxx = xxx+" rowspan="""+Str(a(x-x1,y-y1))+""""
            If b(x-x1,y-y1) > 1 Then xxx = xxx+" colspan="""+Str(b(x-x1,y-y1))+""""
            xxx = xxx+s(x-x1,y-y1)+">"+t(x-x1,y-y1)+"</td>"+Chr(13)+Chr(10)
        End If
    Next x
        xxx = xxx+"</tr>"+Chr(13)+Chr(10)
    Next y
    xxx = xxx+"</table>"+Chr(13)+Chr(10)

Dim CB As New DataObject

With CB
    .SetText xxx
    .PutInClipboard
End With
End Sub

Function Colorset(RGB)
    Colorset = Right("000000"+Hex(RGB),6)
    Colorset = "#"+Right(Colorset,2)+Mid(Colorset,3,2)+Left(Colorset,2)
End Function

Sub テーブルタグ_白黒()
'選択範囲のテーブルタグ（白黒）を書き出すためのマクロ
    Dim t(100,100) As String
    Dim a(100,100) As Long
    Dim b(100,100) As Long

    x1 = Selection.Column
    y1 = Selection.Row
    x2 = x1+Selection.Columns.Count-1
    y2 = y1+Selection.Rows.Count-1
    For x = x1 To x2
    For y = y1 To y2
        ym = Cells(y,x).MergeArea.Row
        xm = Cells(y,x).MergeArea.Column
        a(x-x1,y-y1) = -1
        If x = xm And y = ym Then
            t(x-x1,y-y1) = Cells(y,x).Text
            a(x-x1,y-y1) = 1
            b(x-x1,y-y1) = 1
        Else
            t(x-x1,y-y1) = ""
            If xm = x Then a(xm-x1,ym-y1) = a(xm-x1,ym-y1)+1
            If ym = y Then b(xm-x1,ym-y1) = b(xm-x1,ym-y1)+1
        End If
    Next y
    Next x

    xxx = xxx+"<table border=""1"" cellspacing=""0"" cellpadding=""2"" bordercolor=""black"">"+Chr(13)+Chr(10)
    For y = y1 To y2
        xxx = xxx+"<tr>"
    For x = x1 To x2
        If a(x-x1,y-y1) >= 0 Then
            xxx = xxx+"<td"
            If a(x-x1,y-y1) > 1 Then xxx = xxx+" rowspan="""+Str(a(x-x1,y-y1))+""""
            If b(x-x1,y-y1) > 1 Then xxx = xxx+" colspan="""+Str(b(x-x1,y-y1))+""""
            xxx = xxx+">"+t(x-x1,y-y1)+"</td>"+Chr(13)+Chr(10)
        End If
    Next x
        xxx = xxx+"</tr>"+Chr(13)+Chr(10)
    Next y
    xxx = xxx+"</table>"+Chr(13)+Chr(10)

Dim CB As New DataObject

With CB
    .SetText xxx
    .PutInClipboard
End With
End Sub

EXCEL2003への組み込み方法（多分、2002でも一緒）

  1. EXCELの画面のメニューバーから、[ツール]-[マクロ]-[Visual Basic Editor]を呼び出します。


  2. プロジェクトエクスプローラにVBAProject(PERSONAL.XLS)や、VBAProject(開いているブック名）などが載っているのを確認。
    （プロジェクトエクスプローラが表示されていないときは、[Ctrl]+Rで呼び出します。）

    本プログラムを良く使う予定が有れば、PERSONAL.XLSの標準モジュールに、一時的な使用（もしくは、他PCにコピーする場合など）は、個々のブックの標準モジュールにコラム内のスクリプトをコピー＆ペーストしてください。

    標準モジュールが無い場合は、どれかのVBAProject選択してから、[挿入]-[標準モジュール]にて、標準モジュールを追加した後で、その中にスクリプトをコピー＆ペーストしてください。

    ↓（標準モジュールが無い場合のみ）


    ↓標準モジュールを選択して、その中に、上記のスクリプト2つをまとめてコピー＆ペーストします。


  3. 以上の操作が終わったら、EXCELのワークシートに戻って、テーブルタグを作りたいセル範囲を選択して、 [ツール]-[マクロ]-[▽マクロ]にて、マクロ一覧を表示

    [****テーブルタグ_カラー]か[****テーブルタグ_白黒]をクリックします。

これで、もう、パソコンのクリップボード（コピーバッファ）に、テーブルタグがコピーされていますので、メモ帳などのテキストエディタに貼り付けることが可能です。

本ツールでは、セルの結合と、背景色・テキストの色のみ対応しており、罫線の色は黒、セルの幅はその列の文字列が一番長いセルに合うという状態のタグになりますので、必要に応じて調整してくださいますようお願いします。

PERSONAL.XLSにマクロをコピーした場合は、最後にEXCELを閉じるときなどに、
個人用マクロブックの変更を保存しますか？[はい]をクリックすると、次に、Excelを起動したときにマクロが有効になります。
[はい(Y)][いいえ(N)][キャンセル]
と出ることがありますので、[はい(Y)]をクリックして閉じてください。次から、上記の３番以降からの操作で<TABLE>タグは作りたい放題でございます。

abcdef1 abcdef2
abcdef3
abcdef4 abcdef7 abcdef8
abcdef5 abcdef9
abcdef6
abcdef10 abcdef11
abcdef12 abcdef13
意味も無く、派手なテーブル！！

2009.7.18

[HOME][とまて週報TOP]