EXCEL表をTableタグ(HTML)に変換する 其の弐
前回、エクセルの表をHTML(Tableダグ)に変換するという勉強をしましたが、あとから文字の水平位置くらいは指定できたほうがいいんじゃね?と思ったので、今回は前回のコードを改良し、見出し以外の文字の水平位置を指定できるようにしました。
前回の記事はこちら
プラスαで、当ブログを読んでくれる人の中には、エクセルを便利に使いたいけれどもプログラミングには興味が無く「参照設定ってなに?おいしいの?(゜ρ゜) 」という人も少なからずおられると思うので・・・事前に参照設定を行わなくてもマクロを使えるようにしました。(これについては後日、別途記載したいと思います)
となれば過去に掲載した参照設定ありきのマクロを全部修正したくなりましたが、やはり事前に参照設定を済ませておくほうが処理速度としては速いので当面そのままにします。(面倒くさいとも言い換えることができる)
今回のマクロ(末尾に掲載)を使って出力したHTMLコードを、はてなブログであれば「HTML編集モード」でお好きな位置にペーストして下さい。
表の大きさや、文字の大きさ・色・太さなどは「見たまま編集モード」で変更できるので、マクロの処理対象外とします。
見出しなし左寄せの場合(初期値)
Test | Test | Test | Test | Test |
Test | Test | Test | Test | Test |
Test | Test | Test | Test | Test |
Test | Test | Test | Test | Test |
Test | Test | Test | Test | Test |
見出しなし中央揃えの場合
Test | Test | Test | Test | Test |
Test | Test | Test | Test | Test |
Test | Test | Test | Test | Test |
Test | Test | Test | Test | Test |
Test | Test | Test | Test | Test |
見出しなし右寄せの場合
Test | Test | Test | Test | Test |
Test | Test | Test | Test | Test |
Test | Test | Test | Test | Test |
Test | Test | Test | Test | Test |
Test | Test | Test | Test | Test |
----------------------
Sub 選択範囲をTableタグに変換しクリップボードに出力其の弐()
'正方形または長方形のような連続した選択範囲とする
Dim i As Long
Dim j As Long
Dim V As String
Dim rh As Integer
Dim ch As Integer
Dim mi As Integer
Dim Alg As String
Dim myLib As Object
Set myLib = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") '参照設定なしでDataObjectのインスタンスを生成する
rh = MsgBox("選択範囲の上端の行を" & vbCrLf & "見出しにしますか?", vbYesNo)
ch = MsgBox("選択範囲の左端の列を" & vbCrLf & "見出しにしますか?", vbYesNo)
mi = Application.InputBox(Prompt:="見出し以外の文字の水平位置を指定できます。" & vbCrLf & _
"1:中央揃え" & vbCrLf & "2:右寄せ" & vbCrLf & "3:両端揃え" & vbCrLf & "キャンセル:左寄せ(初期値)", Type:=1)
If TypeName(mi) = "Boolean" Then
Alg = ""
ElseIf mi = 1 Then
Alg = " align=""center"""
ElseIf mi = 2 Then
Alg = " align=""right"""
ElseIf mi = 3 Then
Alg = " align=""justify"""
End If
V = "<table>" & vbCrLf
For i = Selection.Row To Selection.Rows(Selection.Rows.Count).Row
For j = Selection.Column To Selection.Columns(Selection.Columns.Count).Column
If i = Selection.Row And rh = 6 Then '見出し行の処理。データを<th></th>で囲む
If j = Selection.Column Then '選択範囲の左端であれば冒頭に<tr>を追加
V = V & "<tr>" & vbCrLf & "<th>" & Cells(i, j).Value & "</th>"
If j = Selection.Columns(Selection.Columns.Count).Column Then '左端かつ右端である場合の処置
V = V & vbCrLf & "</tr>" & vbCrLf
End If
ElseIf j = Selection.Columns(Selection.Columns.Count).Column Then '選択範囲の右端であれば末尾に</tr>を追加
V = V & "<th>" & Cells(i, j).Value & "</th>" & vbCrLf & "</tr>" & vbCrLf
Else '左端と右端以外の処理
V = V & "<th>" & Cells(i, j).Value & "</th>"
End If
Else '見出し行以外の処理
If j = Selection.Column Then '選択範囲の左端であれば冒頭に<tr>を追加
If ch = 6 Then '見出し列の処理。データを<th></th>で囲む
V = V & "<tr>" & vbCrLf & "<th>" & Cells(i, j).Value & "</th>"
Else '見出し列以外の処理。データを<td></td>で囲む
V = V & "<tr>" & vbCrLf & "<td" & Alg & ">" & Cells(i, j).Value & "</td>"
End If
If j = Selection.Columns(Selection.Columns.Count).Column Then '左端かつ右端である場合の処置
V = V & vbCrLf & "</tr>" & vbCrLf
End If
ElseIf j = Selection.Columns(Selection.Columns.Count).Column Then '選択範囲の右端であれば末尾に</tr>を追加
V = V & "<td" & Alg & ">" & Cells(i, j).Value & "</td>" & vbCrLf & "</tr>" & vbCrLf
Else '左端と右端以外の処理
V = V & "<td" & Alg & ">" & Cells(i, j).Value & "</td>"
End If
End If
Next j
Next i
V = V & "</table>"
myLib.SetText V '変数の値をDataObjectに格納する
myLib.PutInClipboard 'DataObjectのデータをクリップボードに格納する
MsgBox "HTMLをクリップボードに" & vbCrLf & "出力しました!" & vbCrLf & vbCrLf & _
"ブログなどでお好みの位置にペースト" & vbCrLf & "して下さい。"
End Sub
----------------------
※SubからEnd Subまでをコピーし、標準モジュール等に貼り付けて使用して下さい。なお、マクロで実行した処理は「元に戻す」ことができません。実行前に一旦保存しやり直しのできる状態にしておいて下さい。標準モジュールにコードを貼り付けてマクロを使用する方法はこちら。
(2017.11.2 若干のバグ修正)