タグ形式に変換し、クリップボードにコピーする。
‘ Webシステムなどへのデータ連携を想定。
‘ ———————————————————————————–
‘ 参照設定:
‘ このコードはクリップボード操作のために「Microsoft Forms 2.0 Object Library」を
‘ 使用します。VBAエディタの「ツール」->「参照設定」からチェックを入れてください。
‘====================================================================================
Sub ConvertWordTableToHtmlAndCopyToClipboard()
‘====================================================================================
‘ 変数宣言と初期化
‘====================================================================================
Dim objTable As Word.Table ‘ 処理対象のWordテーブルオブジェクト
Dim objRow As Word.Row ‘ テーブルの行オブジェクト
Dim objCell As Word.Cell ‘ テーブルのセルオブジェクト
Dim strHtml As String ‘ 生成されるHTML文字列を格納
Dim lngRow As Long ‘ 行インデックス
Dim lngCol As Long ‘ 列インデックス
Dim lngRowsInTable As Long ‘ テーブルの総行数
Dim lngColsInTable As Long ‘ テーブルの総列数
Dim blnVisitedCells() As Boolean ‘ 結合セルを追跡するためのフラグ配列
Dim lngColspan As Long ‘ HTMLのcolspan属性値
Dim lngRowspan As Long ‘ HTMLのrowspan属性値
Dim objClipboard As Object ‘ クリップボード操作用のDataObjectオブジェクト
‘ エラーハンドリングの開始
On Error GoTo ErrorHandler
‘====================================================================================
‘ 1. 処理対象の表の取得と検証
‘====================================================================================
‘ 現在の選択範囲に表が含まれているか確認
If Selection.Tables.Count = 0 Then
MsgBox “カーソルが表の中にありません。変換したい表の中にカーソルを置いて実行してください。”, vbExclamation
Exit Sub
End If
‘ 選択範囲内の最初の表を取得（通常、カーソルがある表が対象となる）
Set objTable = Selection.Tables(1)
‘—————————————————————-
‘ colspanの計算（横方向の結合セルを検出）
‘—————————————————————-
‘ 現在のセルのRange.Start位置を基準に、右隣のセルと比較
Dim currentCellRangeStart As Long
currentCellRangeStart = objCell.Range.Start
For lngColNext = lngCol + 1 To lngColsInTable
‘ 次の列のセルが現在のセルと同じRange.Start位置を持つ場合、結合されていると判断
If objTable.Cell(lngRow, lngColNext).Range.Start = currentCellRangeStart Then
lngColspan = lngColspan + 1
‘ 結合されたセルは訪問済みとしてマーク
blnVisitedCells(lngRow, lngColNext) = True
Else
Exit For ‘ 結合が途切れたらループを抜ける
End If
Next lngColNext
‘—————————————————————-
‘ rowspanの計算（縦方向の結合セルを検出）
‘—————————————————————-
For lngRowNext = lngRow + 1 To lngRowsInTable
‘ 次の行のセルが現在のセルと同じRange.Start位置を持つ場合、結合されていると判断
If objTable.Cell(lngRowNext, lngCol).Range.Start = currentCellRangeStart Then
lngRowspan = lngRowspan + 1
‘ 結合されたセルは訪問済みとしてマーク
‘ colspanの範囲も考慮してマークする
For i = lngCol To lngCol + lngColspan – 1
blnVisitedCells(lngRowNext, i) = True
Next i
Else
Exit For ‘ 結合が途切れたらループを抜ける
End If
Next lngRowNext
‘ セル内容の末尾にある余分な改行/タブ文字を除去（WordのRange.Textの特性）
If Right(cellText, 2) = “ ” Then
cellText = Left(cellText, Len(cellText) – 2)
End If
If Right(cellText, 1) = Chr(7) Then ‘ Chr(7)はWordのセル末尾にある隠れた文字
cellText = Left(cellText, Len(cellText) – 1)
End If
strHtml = strHtml & cellText & “
” & vbCrLf
NextCell: ‘ 次のセルへのジャンプポイント
Next lngCol
strHtml = strHtml & ”
” & vbCrLf ‘
タグの終了
Next lngRow
‘
タグの終了
strHtml = strHtml & “
”
‘====================================================================================
‘ 3. 生成したHTMLをクリップボードへコピー
‘====================================================================================
‘ クリップボードオブジェクトのインスタンスを作成
‘ この行がエラーになる場合は、「ツール」->「参照設定」で
‘ 「Microsoft Forms 2.0 Object Library」にチェックが入っているか確認してください。
Set objClipboard = New MSForms.DataObject
objClipboard.SetText strHtml
objClipboard.PutInClipboard
If Selection.Tables.Count = 0 Then
MsgBox “カーソルが表の中にありません。変換したい表の中にカーソルを置いて実行してください。”, vbExclamation
Exit Sub
End If
Set objTable = Selection.Tables(1)
‘ … 中略 …
Dim blnVisitedCells() As Boolean ‘ 結合セルを追跡するためのフラグ配列
‘ … 中略 …
ReDim blnVisitedCells(1 To lngRowsInTable, 1 To lngColsInTable)
‘ … 中略 …
If blnVisitedCells(lngRow, lngCol) Then
GoTo NextCell
End If
‘ … 中略 …
currentCellRangeStart = objCell.Range.Start
For lngColNext = lngCol + 1 To lngColsInTable
If objTable.Cell(lngRow, lngColNext).Range.Start = currentCellRangeStart Then
lngColspan = lngColspan + 1
blnVisitedCells(lngRow, lngColNext) = True
Else
Exit For
End If
Next lngColNext
‘ … rowspanの計算も同様に …
