＜改行LFを<BR>などHtml用にエンコードして書き込む＞
どうも、三流プログラマーのＫｅｎ３です。 今回は、前回の続きで、 Excelの表をHTMLの表にしてみたいと思います。 標準でHTML形式で保存があるけど、練習を兼ねて。 http://www.ken3.org/p/lzh/office-018.lzh に今回のサンプル保存されてます。 あわせてみてください。/* * １．追加機能や足りない機能、使っていっての要望をまとめる */
前回、表の基本形を書き込めました。 なんとか、 ・右寄せ左寄せ、中央寄せのパターン ・背景色、フォントの色に対応 を書きました。 まだまだ、機能的に足りないだけど、 今回は、 HTMLで無視されてしまうスペース、改行 や ＜＞％”を変更してみたいと思います。/* * ２．初期捜査、初動捜査 */
セルへの入力で、Alt+リターンでセル内で改行することが出来ます。 AAA BBB みたいに２行で書くことが出来ます。 A1列にテストでAAA(Alt+Return)BBBと入力します。 中に入っている文字コードを表示してみます。
Sub codetest()
Dim strMOJI As String
Dim n As Integer
For n = 1 To Len(Range("A1").Value)
strMOJI = Mid(Range("A1").Value, n, 1)
Debug.Print "[" & strMOJI & "]code=" & Hex(Asc(strMOJI))
Next n
End Sub |
Function htmlEnCode(strMOTO As String) As String
Dim strCHK As String 'チェックする文字
Dim strSET As String 'セットする文字
Dim strWORK As String '結果を入れる作業変数
Dim n As Integer 'カウンター
'結果をまず初期化する
strWORK = ""
'文字数分ループする
For n = 1 To Len(strMOTO)
strCHK = Mid(strMOTO, n, 1) 'チェックする文字を取り出す
Select Case Asc(strCHK) '文字をチェックする
Case &H20: strSET = " " 'スペース
Case &H3C: strSET = "<" '<
Case &H3E: strSET = ">" '>
Case &H26: strSET = "&" '&
Case &H22: strSET = """ '"
Case &HA: strSET = "<br>" '改行
Case Else: strSET = strCHK 'その他の文字はそのままセット
End Select
'文字列を作る
strWORK = strWORK & strSET
Next n
'作られた文字列をリターン値としてセットする
htmlEnCode = strWORK
End Function |
Sub Main()
'Application.InputBoxでセルを選択させる
Dim objTARGET As Range '選択されたセルの集合
Set objTARGET = Application.InputBox(prompt:="セルを選択", Type:=8)
If IsEmpty(objTARGET) Then 'キャンセルが押されたかチェックする
MsgBox "キャンセルが押されました"
Exit Sub
End If
'ファイル名を作成 ファイル名は自分のパス+\test.html
Dim strFNAME As String 'ファイル名保存用
strFNAME = ThisWorkbook.Path & "\test.html" 'ファイル名を作る
'テーブルデータを作成する
Call MAKE_HTML_TABLE(strFNAME, objTARGET)
'できたファイルをIEで表示して確認する
Call IE_OPEN_URL(strFNAME) 'ファイル名を渡す
'終わりの挨拶
MsgBox strFNAME & "を作成しました"
End Sub |
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 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:
Print #FNO, "<TD ALIGN='RIGHT'";
Case xlLeft:
Print #FNO, "<TD ALIGN='LEFT'";
Case xlCenter:
Print #FNO, "<TD ALIGN='CENTER'";
Case Else 'その他設定無しのとき
Print #FNO, "<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)
Print #FNO, " BGCOLOR=#" & strR & strG & strB;
End If
Print #FNO, ">"; 'タグを閉じる
'フォントの色を調べる
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)
Print #FNO, "<Font Color=#" & strR & strG & strB & ">";
End If
'セルの中身を変換して書き込む*018で追加
Print #FNO, htmlEnCode(objHANI.Cells(y, x).Value);
'フォントのタグを閉じる
If strCOLOR <> "000000" Then '黒以外の時処理
Print #FNO, "</Font>";
End If
'タグを閉じる
Print #FNO, "</TD>";
Next x
Print #FNO, "</TR>" '行の終了タグ
Next y
'HTMLのタグを閉める
Print #FNO, "</TABLE>"
Print #FNO, "</BODY></HTML>"
'ファイルをクローズする
Close #FNO
End Sub |
Sub IE_OPEN_URL(strURL As String)
'ＩＥを起動して、表示
Dim objIE As Object 'ＩＥオブジェクト参照用
'インターネットエクスプローラーのオブジェクトを作る
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True '見えるようにする(お約束)
objIE.Navigate strURL '文字列で指定したＵＲＬに飛ぶ
End Sub |
Function htmlEnCode(strMOTO As String) As String
Dim strCHK As String 'チェックする文字
Dim strSET As String 'セットする文字
Dim strWORK As String '結果を入れる作業変数
Dim n As Integer 'カウンター
'結果をまず初期化する
strWORK = ""
'文字数分ループする
For n = 1 To Len(strMOTO)
strCHK = Mid(strMOTO, n, 1) 'チェックする文字を取り出す
Select Case Asc(strCHK) '文字をチェックする
Case &H20: strSET = " " 'スペース
Case &H3C: strSET = "<" '<
Case &H3E: strSET = ">" '>
Case &H26: strSET = "&" '&
Case &H22: strSET = """ '"
Case &HA: strSET = "<br>" '改行
Case Else: strSET = strCHK 'その他の文字はそのままセット
End Select
'文字列を作る
strWORK = strWORK & strSET
Next n
'作られた文字列をリターン値としてセットする
htmlEnCode = strWORK
End Function |
ここまで、読んでいただきどうもです。ここから下は、三流君のホームページの紹介・案内です
目的の情報が見つかったか？少々心配しつつ、、、
|
気になったジャンル↓を選択してください。 人気記事(来場者が多いTOP3): Excel関係: Access関係: その他：VBAの共通関数やテキストファイルの操作など 開発時の操作: [F1を押してHELPを見る]/ [Debug.Print と イミディエイトウインドウ]/ [実行時エラーでデバッグ]/ [ウォッチ式とSTOP]/ [参照設定を行う] 仕様書(設計書？) XXXX書類: [基本設計書や要求仕様書]/ [テスト仕様書 テストデータ]/ [バグ票]/ [関数仕様書]/ [流れは 入力・処理・出力] ※↑文章の味付けが変わっていて、お口に合うかわかりませんが。。。 |
Blogとリンク:[三流君の作業日記]/
[VBAやASPのサンプルコード]/
広告-[通販人気商品の足跡]