Excelおじさん用だよ!
TwitterBootstrapのテーブルをつくるときExcelの表をもとにしたいのでつくりました。
VBAデス!
使い方
表にしたい範囲を選択してから実行してくださいね。
生成されたHTMLはクリップボードにコピーされるよ。
※1行目はヘッダーだよ。
ソース
' Excel表の選択範囲のセルをもとにTwitterBootstrap2.xのテーブル(HTML)を生成する
' 2013.08.09 Fukaya
' ※生成されたHTMLはクリップボードにコピーされます。
' ※1行目はヘッダ行になります
' ※メニューの「ツール」→「参照設定」で「Microsoft Forms 2.0 Object Library」を選択しておく必要があります。(クリップボード操作のため)
Option Explicit
Dim htmlOut As String ' 生成されるHTML
Sub MakeBootStrapHtmlTable()
' 選択範囲
Dim x0 As Integer
Dim y0 As Integer
Dim w As Integer
Dim h As Integer
' 変数
Dim x As Integer
Dim y As Integer
Dim rowHtml As String
' 選択範囲取得
x0 = Selection.Cells(1).Column
y0 = Selection.Cells(1).Row
w = Selection.Cells(Selection.Count).Column - x0 + 1
h = Selection.Cells(Selection.Count).Row - y0 + 1
Debug.Print "選択範囲:" & x0 & "," & y0 & "," & w & "," & h
If w < 1 Or h < 2 Then
MsgBox "選択範囲が狭すぎます。" & vbCrLf & "1桁2行以上を選択する必要があります。"
Exit Sub
End If
' 生成されるHTML初期化
ClearHtml
' 処理開始
' テーブル
AddHtml 0, "<table class='table table-striped table-bordered table-condensed'>"
' テーブルヘッダ
AddHtml 1, "<thead>"
rowHtml = "<tr>"
For x = x0 To x0 + w - 1
rowHtml = rowHtml & "<th>" & MakeHtml(Cells(y0, x)) & "</th>"
Next
rowHtml = rowHtml & "</tr>"
AddHtml 2, rowHtml
AddHtml 1, "<thead>"
' データブロック
AddHtml 1, "<tbody>"
For y = y0 + 1 To y0 + h - 1
' データ行
rowHtml = "<tr>"
For x = x0 To x0 + w - 1
rowHtml = rowHtml & "<td>" & MakeHtml(Cells(y, x)) & "</td>"
Next
rowHtml = rowHtml & "</tr>"
AddHtml 2, rowHtml
Next
AddHtml 1, "<tbody>"
' /テーブル
AddHtml 0, "</table>"
' 完了
Debug.Print htmlOut
' 'A) InputBoxで結果を表示する場合(文字列長制限あり)
' InputBox "コピーしてお使いください", "テーブル用HTMLを生成しました。", htmlOut
'B) クリップボードにコピーする場合(参照設定が必要です)
CopyToClipboard htmlOut
MsgBox "テーブル用HTMLを生成しました。" + vbCrLf + "クリップボードにコピーしました。"
End Sub
Sub ClearHtml()
htmlOut = ""
End Sub
Sub AddHtml(tabs As Integer, str As String)
Dim i As Integer
For i = 0 To tabs - 1
htmlOut = htmlOut & vbTab
Next
htmlOut = htmlOut & str & vbCrLf
End Sub
Function MakeHtml(str As String) As String
str = Replace(str, vbLf, "<br/>")
MakeHtml = str
End Function
Sub CopyToClipboard(str As String)
Dim MyDataObject As DataObject
Set MyDataObject = New DataObject
MyDataObject.SetText str
MyDataObject.PutInClipboard
End Sub