差分

この文書の現在のバージョンと選択したバージョンの差分を表示します。

この比較画面にリンクする

office:2003:excel:vba00 [2010/08/08 12:06]
miyako
office:2003:excel:vba00 [2010/08/08 15:01] (現在)
miyako
ライン 7: ライン 7:
   <head>   <head>
     <title>エクセル マクロ テスト</title>     <title>エクセル マクロ テスト</title>
-    <meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS" />+    <meta http-equiv="Content-Type" content="text/html;  
 +                     charset=Shift_JIS" />
   </head>   </head>
   <body>   <body>
ライン 40: ライン 41:
  
 '挿入用HTMLを作成 '挿入用HTMLを作成
-'ここは既に出来てると思うけど・・・ファイルに書きだしてるのかな? 
 'vbNewLineは改行の意味なので適当にHTMLを生成してくださいwww 'vbNewLineは改行の意味なので適当にHTMLを生成してくださいwww
 'SHTMLという変数に差し込みたいHTMLを全て入れるのがポイントね 'SHTMLという変数に差し込みたいHTMLを全て入れるのがポイントね
 +'このサンプルではvbaが組み込まれたシートのX=3,Y=7からY軸を下に
 +'確認していき空白になるまで繰返しテーブルタグに入れるって書いてます
 CNT = 7 CNT = 7
 SHTML = SHTML & "<table>" & vbNewLine SHTML = SHTML & "<table>" & vbNewLine
ライン 53: ライン 55:
 SHTML = SHTML & "</table>" SHTML = SHTML & "</table>"
  
-'SHTML = "<font size=7>" & vbNewLine & Cells(7, 3) & vbNewLine & "</font>" 
  
 '読込む用のHTMLファイルを選択する '読込む用のHTMLファイルを選択する
ライン 65: ライン 66:
     )     )
  
 +'キャンセルボタンを押された場合はこのコードは終了します
 If SFILE = False Then If SFILE = False Then
   Exit Sub   Exit Sub
ライン 80: ライン 82:
   , Title:="保存ファイル選択" _   , Title:="保存ファイル選択" _
   )   )
-  + 
 +'キャンセルボタンを押された場合はこのコードは終了します
 If WFILE = False Then If WFILE = False Then
   Exit Sub   Exit Sub
ライン 111: ライン 114:
  
 End Sub End Sub
 +</code>
 +
 +
 +さて、このままでも問題は無いのだけど・・・どうせなら他のアプリケーションに読ませる可能性も考慮して
 +
 +出力ファイルの文字コードをEUCにするコードも考えてみよう
 +
 +
 +<code>
 +
 +Private Sub CommandButton1_Click()
 +'変数の宣言
 +Dim xlAPP As Application
 +Dim SFILE As Variant
 +Dim WFILE As Variant
 +Dim intFFIN As Integer
 +Dim strREC As String
 +Dim CNT As Integer
 +Dim txt As Object
 +
 +
 +'挿入用HTMLを作成
 +'vbNewLineは改行の意味なので適当にHTMLを生成してくださいwww
 +'SHTMLという変数に差し込みたいHTMLを全て入れるのがポイントね
 +'このサンプルではvbaが組み込まれたシートのX=3,Y=7からY軸を下に
 +'確認していき空白になるまで繰返しテーブルタグに入れるって書いてます
 +CNT = 7
 +SHTML = SHTML & "<table>" & vbNewLine
 +Do While Cells(CNT, 3) <> ""
 +  SHTML = SHTML & "  <tr><td>" & vbNewLine
 +  SHTML = SHTML & "  " & Cells(CNT, 3) & vbNewLine
 +  SHTML = SHTML & "  </td></tr>" & vbNewLine
 +  CNT = CNT + 1
 +Loop
 +SHTML = SHTML & "</table>"
 +
 +
 +'読込む用のHTMLファイルを選択する
 +'読込むHTMLが固定の場合はSFILEにPathを書いてね
 +SFILE = _
 +  Application.GetOpenFilename( _
 +    Filefilter:="HTML(*.html),すべてのファイル(*.*)" _
 +    , FilterIndex:=1 _
 +    , Title:="元ファイルを選択" _
 +    , MultiSelect:=False _
 +    )
 +
 +If SFILE = False Then
 +  Exit Sub
 +End If
 +
 +'書き込む用のHTMLファイルを選択する
 +'初期のファイル名はmarge.htmlになってるので
 +'ここは適当に変更してみてね
 +Set xlAPP = Application
 +xlAPP.StatusBar = "保存ファイル選択"
 +WFILE = _
 +  xlAPP.GetSaveAsFilename( _
 +  InitialFileName:="marge.html", _
 +  Filefilter:="HTML(*.html),すべて(*.*)" _
 +  , Title:="保存ファイル選択" _
 +  )
 +  
 +If WFILE = False Then
 +  Exit Sub
 +End If
 +
 +'読み込み用HTMLのオープン
 +intFFIN = FreeFile
 +Open SFILE For Input As #intFFIN
 +
 +'書き込み用HTMLのオープン
 +Set txt = CreateObject("ADODB.Stream")
 +txt.Type = 2
 +'文字コードをEUC-JPにセットしている。UTF-8の場合はそのままUTF-8とすればオッケー
 +txt.Charset = "EUC-JP"
 +
 +txt.Open
 +
 +'読み込み用ファイルを1行づつ読込んでる
 +Do Until EOF(intFFIN)
 +  Line Input #intFFIN, strREC
 +  '差換える文字列を発見したらSHTMLで置換する
 +  '差換える文字列は適当に変更してね
 +  strREC = Replace(strREC, "<!---Target-->", SHTML)
 +  'オブジェクトに一時的に書き出す
 +  txt.writetext strREC, 1
 +Loop
 +
 +'txtというオブジェクトに格納していたのを指定したファイル名で書き出してます。
 +'2は新規作成か上書き保存というオプション。デフォルトの1は新規作成はするが
 +'上書きはしない
 +txt.savetofile (WFILE), 2
 +
 +
 +'処理が終わった後は閉じますねwww
 +txt.Close
 +Set txt = Nothing
 +xlAPP.StatusBar = False
 +
 +Close #intFFIN
 +
 +MsgBox ("処理が完了したよ(^^)")
 +
 +End Sub
 +
 +</code>
 +
 +さぁ、どこが変わってるかわかったかな?\\
 +コメントを参考にして自分の環境に合わせて自由に使ってみてください(^^)
 +
 +あっ!\\
 +吐き出すHTMLファイルの文字コードを変える場合は、最初に作成したHTMLのMETAタグの\\
 +文字コードも修正が必要ですよ(^^;)
 +
 +<code>
 +<meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS" />
 +  ↓
 +<meta http-equiv="Content-Type" content="text/html; charset=EUC-JP" />
 </code> </code>
  
office/2003/excel/vba00.1281269209.txt.gz · 最終更新: 2010/08/08 12:06 by miyako
CC Attribution-Noncommercial-Share Alike 3.0 Unported
www.chimeric.de Valid CSS Driven by DokuWiki do yourself a favour and use a real browser - get firefox!! Recent changes RSS feed Valid XHTML 1.0