Excelの表からhtmlタグ化したかったので作成しました。結果はメモ帳に出力されます。
- メモ帳にクリップボード経由で渡していますが、処理が追い付かず空白のメモ帳が開いてしまう場合にはコードの最後にある待ち時間のところ、２カ所の秒数を調整してみてください。
- 「blnWidthAutoCal 」の設定を変えるとwidthを指定するかなしにするか選べます。（指定ありの場合は、セル幅から%を計算します）
コード
※ダウンロードはテキストですが、htmlタグが書いてあるため、zipにしています。
Option Explicit
Option Base 1
Sub CellToHTMLConvert()
'------------------------------------------------------------------------------
' 選択した範囲を htmlタグ に変換してメモ帳へ出力する
' 1) セルの装飾は一切出力しない
' 2) width(%)はセル幅から自動計算（True：計算する、False：計算しない）
' 3) heightは出力しない
' [補足]
' ・メモ帳への受け渡しは変数かつクリップボード経由
' （データがあまりに多いのは推奨できない方式のため、1000 セル以上選択されていると中断）
'------------------------------------------------------------------------------
'width をセル幅から自動計算するか (True:計算する、False：計算しない）
Const blnWidthAutoCal As Boolean = True
Dim MsgRtn As Long 'msgboxの戻り値
Dim wkRng As Range '選択範囲記憶
Dim strText As Variant 'クリップボードに渡すデータ
Dim SumColWidth As Single '列幅
Dim ColWidth '列幅のパーセンテージ用配列
Dim i As Long 'colWidthの添え字用変数
Dim r As Long, c As Long
Dim rowSt As Long, rowEd As Long, colSt As Long, colEd As Long
'タグ文字列
' 固定分
Const strTagTableTbodySt As String = "<table style=""border-collapse: collapse; width: 100%;"">" & vbCrLf & "<tbody>" & vbCrLf
Const strTagTrSt As String = "<tr>" & vbCrLf
Const strTagTdEd As String = "</td>" & vbCrLf
Const strTagTrEd As String = "</tr>" & vbCrLf
Const strTagTableTbodyEd As String = "</tbody>" & vbCrLf & "</table>" & vbCrLf
' 可変分
Dim strTagTdSt1 As String
Dim strTagTdSt2 As String
'オプションによりtdタグ変更
If blnWidthAutoCal = True Then
strTagTdSt1 = "<td style=""width: "
strTagTdSt2 = "%;"">"
Else
strTagTdSt1 = "<td"
strTagTdSt2 = ">"
End If
'選択範囲に値があるか確認（値がなければ終了）
If WorksheetFunction.CountA(Selection) = 0 Then
Exit Sub
End If
'選択範囲を記憶
Set wkRng = Selection
If Selection.Count > 100 Then
MsgRtn = MsgBox("セルが100個以上選択されていますが、実行しますか？" & vbCrLf & vbCrLf, _
vbOKCancel + vbInformation + vbDefaultButton2, Title:="確認")
If MsgRtn = vbCancel Then Exit Sub
ElseIf Selection.Count > 1000 Then
MsgRtn = MsgBox("セルが1000個以上選択されているので、中断します。" & vbCrLf & vbCrLf & _
vbExclamation + vbInformation, Title:="中断")
Exit Sub
End If
'列と行を取得
rowSt = Selection(1).Row
rowEd = Selection(Selection.Count).Row
colSt = Selection(1).Column
colEd = Selection(Selection.Count).Column
'tdタグ用のWidthを格納する変数（オプションFalse時は空白）
ReDim ColWidth(Columns.Count)
'tdタグ用のWidthを計算
If blnWidthAutoCal = True Then
'列幅の総計を取得
For c = colSt To colEd
SumColWidth = SumColWidth + Columns(c).ColumnWidth
Next c
'列幅のパーセンテージを計算
i = 0
For c = colSt To colEd
i = i + 1
'小数点4桁まで (6桁までとってそれより下は切り捨て、パーセンテージ変換で100をかける）
ColWidth(i) = WorksheetFunction.RoundDown(Columns(c).ColumnWidth / SumColWidth, 6) * 100
Next c
End If
'tableタグ、tbodyタグ
strText = strTagTableTbodySt
'セル内容をtr/tdタグとともに出力
For r = rowSt To rowEd
'trタグ
strText = strText & strTagTrSt
i = 0
For c = colSt To colEd
i = i + 1
'tdタグとともにセル内容を出力
strText = strText & strTagTdSt1 & ColWidth(i) & strTagTdSt2 & Cells(r, c).Text & strTagTdEd
Next c
'trタグ（閉じ）
strText = strText & strTagTrEd
Next r
'tableタグ、tbodyタグ（閉じ）
strText = strText & strTagTableTbodyEd
'クリップボードに格納
With CreateObject("Forms.TextBox.1")
.MultiLine = True
.Text = strText
.SelStart = 0
.SelLength = .TextLength
.Copy
End With
'待ち（処理が追い付かない場合、調整）
Application.Wait Now() + TimeValue("00:00:02")
'メモ帳起動
Shell "notepad", 1
'待ち（処理が追い付かない場合、調整）
Application.Wait Now() + TimeValue("00:00:01")
'メモ帳に貼り付け
SendKeys "^V", True
'元の選択範囲を選ぶ
wkRng.Select
End Sub
