エクセルマクロ、VBAを利用してHTML自動出力（その2）

前回の投稿「エクセルマクロ、VBAを利用してHTML自動出力（その1）」でVBAの概要を説明しましたので、今回は実際のVBAを見ながらの説明です。

テンプレートの準備

まずはテンプレートを準備します。

テンプレートは今回は3種類を用意しています。若干制御構文で利用テンプレートを制御しています。

1.詳細画面用テンプレート

2.一覧画面NEWなし用テンプレート

3.一覧画面NEWあり用テンプレート

詳細画面用テンプレート

="<div id=""main"">
<h2>"&E1&"</h2>
<p class=""createdate"">"&F1&"</p>
<p class=""category"">"&D1&"</p>
<div class=""body"">
<p>"&G1&"</p>
</div>
</div>"

一覧画面NEWなし用テンプレート

="<tr>
<td><a href="""&D1&B1&".html"">"&E1&"</a></td>
<td>"&D1&"</td>
<td>"&F1&"</td>
</tr>

一覧画面NEWあり用テンプレート

="<tr>
<td><a href="""&D1&B1&".html"">"&E1&"</a><img class=""img-new"" src=""../img/new.gif"" alt=""新着マーク""></td>
<td>"&D1&"</td>
<td>"&F1&"</td>
</tr>

オペレーション手順

エクセルは3つのシートを用意しています。

動作パネルシートはマクロ起動ボタンを設置しているだけです。

リスト【追加分】シートは今回の更新作業で追加されるアイテムのリストになります。このためエクセルを開いた段階では空白です。

また、処理終了時も空白になるように設定しています。

リスト【以前】シートは現状の一覧リストになります。

まずはリスト【追加分】シートに追加するアイテム情報を入力します。

ここでのリスト内容は更新作業仕様により変更されると思うので、適宜変更してください。

オペレーション順は今回は

1.追加アイテムをリスト【追加分】シートに記入

2.詳細画面を出力

3.追加アイテムを一覧に追加し、一覧画面を出力

の3ステップです。

詳細画面の出力

一覧に上記のようなアイテム情報を入力しました。

動作パネルシートの「1.詳細ページの生成」ボタンを押すと詳細画面が自動生成される仕組みです。

ボタン押下時に動作するVBAを確認していきます。

Sub 個別ページの生成()
' 個別ページの生成 Macro
Dim i As Long, r As Long
Dim buf As String
Dim f_path As String
Dim f_num As Integer
Dim g_file As String

g_file = Application.GetOpenFilename(FileFilter:="textファイル,*.txt", Title:="テンプレートファイルの読み込み")
Sheets("リスト【追加分】").Select
With CreateObject("Scripting.FileSystemObject")
With .GetFile(g_file).OpenAsTextStream
buf = .ReadAll
.Close
End With
End With
Range("J1") = buf

Range("J1").Select
Selection.Copy

For i = 2 To 10000
Range("A" & i).Select
If Selection <> "" Then
Range("K" & i).Select
ActiveSheet.Paste
ElseIf Selection = "" Then
r = i - 1
Exit For
End If
Next i

Range("K2:K" & r).Select
Selection.Copy
Range("L2").PasteSpecial Paste:=xlPasteValues

For i = 2 To 10000
Range("L" & i).Select
fName = Range("D" & i).Value & Range("B" & i).Value
f_path = ActiveWorkbook.Path & "\" & fName & ".txt"
f_num = Range("C" & i).Value
If Selection <> "" Then
Open f_path For Output As f_num
Print #f_num, Range("L" & i).Value
Close f_num
ElseIf Selection = "" Then
r = i - 1
Exit For
End If
Next i

Columns("L").Delete
Columns("K").Delete
Columns("J").Delete

End Sub

VBAの説明は前回行ったので今回は簡単に日本語で処理手順を記述します。

まずは詳細画面用のテンプレートファイルを読み込みます。

読み込んだ内容をJ1セルにセットします。

K列のアイテム情報のある行にJ1のテンプレート内容をペーストしていきます。

K列のペーストした行を選択しL列に値コピーします。

L列の値を1行ずつD列+B列のファイル名でこのエクセルファイルのある場所にtextファイルを生成していきます。

L列、K列、J列の値を削除します。

こんな感じになります。

引き続き、一覧ファイルの生成です。

一覧画面の出力

Sub 追加分の移動()
' 追加分の移動 Macro

Dim i As Long, r As Long
Dim i2 As Long, r2 As Long
Dim i3 As Long, r3 As Long
Dim i4 As Long, r4 As Long
Dim i5 As Long
Dim g_file As String
Dim g_file2 As String
Dim f_path As String
Dim f_num As Integer

Sheets("リスト【追加分】").Select
For i = 2 To 10000
Range("A" & i).Select
If Selection = "" Then
r = i - 1
Exit For
End If
Next i

Range("A2:H" & r).Select
Selection.Copy
Sheets("リスト【以前】").Select
For i2 = 1 To 10000
Range("A" & i2).Select
If Selection = "" Then
r2 = i2
Exit For
End If
Next i2
Range("A" & r2).Select
ActiveSheet.Paste

For i3 = 1 To 10000
Range("A" & i3).Select
If Selection = "" Then
r3 = i3 - 1
Exit For
End If
Next i3
Range("A1:K" & r3) _ 
 .Sort Key1:=Range("C1"), order1:=xlAscending, _
Key2:=Range("A1"), order2:=xlDescending

Sheets("リスト【追加分】").Select
Range("A2:K" & r).Delete
Range("A2:K" & r).Borders.LineStyle = xlLineStyleNone

g_file = Application.GetOpenFilename(FileFilter:="textファイル,*.txt", Title:="NEWなし一覧の選択 ") 

Sheets("リスト【以前】").Select
With CreateObject("Scripting.FileSystemObject")
With .GetFile(g_file).OpenAsTextStream
buf = .ReadAll
.Close
End With
End With
Range("J1") = buf

g_file2 = Application.GetSaveAsFilename(FileFilter:="textファイル,*.txt", Title:="NEWあり一覧の選択 ")

Sheets("リスト【以前】").Select
With CreateObject("Scripting.FileSystemObject")
With .GetFile(g_file2).OpenAsTextStream
buf = .ReadAll
.Close
End With
End With
Range("K1") = buf

For i4 = 1 To 10000
Range("H" & i4).Select
If Selection = "" Then
r4 = i4 - 1
Exit For
ElseIf Selection = 1 Then
Range("K1").Copy
Range("L" & i4).PasteSpecial
ElseIf Selection = 0 Then
Range("J1").Copy
Range("L" & i4).PasteSpecial
End If
Next i4

Range("L1:L" & r4).Copy
Range("M1").PasteSpecial Paste:=xlPasteValues
f_path = ActiveWorkbook.Path & "\" & "entry_list.txt"
Open f_path For Output As #1

For i5 = 1 To 1000
Range("M" & i5).Select
If Selection = "" Then
Exit For
Else Print #1, Range("M" & i5).Value
End If
Next i5
Close 1

Range("J1:M" & r4).Delete

End Sub

リスト【追加分】シートから一覧情報のある行を確認し、コピーします。

リスト【以前】シートから一覧情報の最終行を確認し、上記をペーストします。

リストをC1、A1の順にソート。

リスト【追加分】のデータを全て削除します。

NEWマークのついていないテンプレートと、NEWマークのついているテンプレートを順に呼び出し、それぞれJ1とK1にセットします。

H列を1行ずつ参照し、値が1であればNEWマークあり、値が0であればNEWマーク無を1行ずつentry_list.txtに書き込みしていきます。

テンプレートを一時的に貼り付けていたセルの内容を削除します。

以上です。