Sub MAKE_HTML_TABLE(strFNAME As String, objHANI As Range)
Dim strCOLOR As String
Dim strR As String
Dim strG As String
Dim strB As String
Dim objMA As Range 'リンクの範囲
Dim strTD As String
'ファイルをオープンする
Dim FNO As Integer 'ファイル番号
FNO = FreeFile '空いてるファイル番号を取出す
Open strFNAME For Output As #FNO 'テキストファイルを新規作成
'HTMLのヘッダーを書く
Print #FNO, "<HTML><HEAD><TITLE>"
Print #FNO, "テーブル作成してみました"
Print #FNO, "</TITLE></HEAD>"
Print #FNO, "<BODY>"
Print #FNO, "<TABLE border=1>" 'テーブルの開始
'行、列でループを作る
Dim y As Integer
Dim x As Integer
For y = 1 To objHANI.Rows.Count '行のループ
Print #FNO, "<TR>" '行の開始タグ
For x = 1 To objHANI.Columns.Count '列のループ
'ALIGNを調べて書き込む
Select Case objHANI.Cells(y, x).HorizontalAlignment
Case xlRight:
strTD = "<TD ALIGN='RIGHT'"
Case xlLeft:
strTD = "<TD ALIGN='LEFT'"
Case xlCenter:
strTD = "<TD ALIGN='CENTER'"
Case Else 'その他設定無しのとき
strTD = "<TD"
End Select
'バックカラーを調べる
strCOLOR = Right("000000" & Hex(objHANI.Cells(y, x).Interior.Color), 6)
If strCOLOR <> "FFFFFF" Then '白以外の時処理
strR = Mid(strCOLOR, 5, 2)
strG = Mid(strCOLOR, 3, 2)
strB = Mid(strCOLOR, 1, 2)
strTD = strTD & " BGCOLOR=#" & strR & strG & strB
End If
'セルの結合を判断する
If objHANI.Cells(y, x).MergeCells = True Then '結合セルか？
Set objMA = objHANI.Cells(y, x).MergeArea 'エリアを取り出す
If objMA.Cells(1, 1).Address = objHANI.Cells(y, x).Address Then
'左上なら
If objMA.Columns.Count <> 1 Then
strTD = strTD & " COLSPAN=" & objMA.Columns.Count
End If
If objMA.Rows.Count <> 1 Then
strTD = strTD & " ROWSPAN=" & objMA.Rows.Count
End If
Print #FNO, strTD & ">"; 'タグを閉じ出力
Else
'結合セルでその他なら、データを書かないでＯＫなら
strTD = "" 'タグをクリア（データを出さない）
End If
Else
Print #FNO, strTD & ">"; 'タグを閉じ出力
End If
'フォントの色を調べる
strCOLOR = Right("000000" & Hex(objHANI.Cells(y, x).Font.Color), 6)
If strCOLOR <> "000000" Then '黒以外の時処理
strR = Mid(strCOLOR, 5, 2)
strG = Mid(strCOLOR, 3, 2)
strB = Mid(strCOLOR, 1, 2)
If strTD <> "" Then '出力ありなら
Print #FNO, "<Font Color=#" & strR & strG & strB & ">";
End If
End If
If strTD <> "" Then '出力ありなら
'セルの中身を変換して書き込む*018で追加
Print #FNO, htmlEnCode(objHANI.Cells(y, x).Value);
'フォントのタグを閉じる
If strCOLOR <> "000000" Then '黒以外の時処理
Print #FNO, "</Font>";
End If
'タグを閉じる
Print #FNO, "</TD>";
End If
Next x
Print #FNO, "</TR>" '行の終了タグ
Next y
'HTMLのタグを閉める
Print #FNO, "</TABLE>"
Print #FNO, "</BODY></HTML>"
'ファイルをクローズする
Close #FNO
End Sub |
↑セルプロパティの設定画面
プロパティを知りたかったので、
いつものマクロ記録で記録してみました。
^^^^^^^^^^^^^^^^^^
Range("B6:C6").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("D6:D7").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
さてと、それらしいのは、
おっ、.MergeCells = Trueってのが怪しそうですね。
.MergeCellsにカーソルを合わせて、
F1(Help)を押して、探ってみます。
MergeCells プロパティ
True の場合、セル範囲またはスタイルが結合セルを含みます。
値の取得および設定が可能です。バリアント型 (Variant) の値を使用します。
解説
結合されたセルが含まれるセル範囲を選択すると、指定したセル範囲と実際の
セル範囲が異なる場合があります。選択したセル範囲のアドレスを調べるには、
Address プロパティを使用します。
使用例
次の使用例は、セル A3 がある結合セル範囲に値を設定します。
Set ma = Range("a3").MergeArea
If Range("a3").MergeCells Then
ma.Cells(1, 1).Value = "42"
End If
なんだか、よくわからないなぁ(笑)。
↑テスト画面、なんとか動作しました。。。