「直近記事一覧」は Excel を html で出力していたが、管理上の問題がある。
-
- 作成後、内容の間違いに気が付いても修正ができず、作り直しになる。
- 新しい分の追加ができない。常に作り直しになる。
そこで、はてな記法による表にするため、 Excel マクロを作っていたが、ようやく完成した。
手法としては、
- 2004年1月1日の記事(ブログ)に固定してある。
- 「まりふのひと」のヘッダー または「麻里府発」の 直近記事一覧 をクリックすると、2004.01.01 の記事に移動する。
- はてなの表組み記法 を使っている。
- 曜日の 土・日 は色を変えてみた。
※ 注)
- カテゴリが無い記事は無視される。
- 削除するカテゴリは "[MAPS-77]", "[MAPS-MK]", "[MAPS-NY]", "[MAPS-TA]", "[MAPS-TP]", "[MAPS-YY]" で組み込み。
- Criterial1 を array で指定すると、or 条件で 3っ以上指定できることが解った。
※ コード(参考)
半角“<”はタグと判断されるため、半角 “&lt;” に置き換えた。
- Public Function make直近記事TextTable(argPath As String) As Boolean
- On Error GoTo Error_make直近記事TextTable
- Dim mbTitle As String
- Dim myFSO As Object, myTS As Object
- Dim lngRow As Long, LastRow As Long
- Dim strDate As String, strTitle As String, strAddress As String
- Dim LastAddress As String, strCategory As String, strWeekday As String
- mbTitle = "make直近記事TextTable/" & MyObjName
- 'フィルターでカテゴリからMiPS予定を削除する。
- 'Ctrl+End
- ActiveCell.SpecialCells(xlLastCell).Select
- LastAddress = ActiveCell.Address
- Range("A1").Select
- Selection.AutoFilter
- ActiveSheet.Range("$A$1:" & LastAddress).AutoFilter Field:=3 _
- , Criteria1:=Array("[MAPS-77]", "[MAPS-MK]", "[MAPS-NY]", "[MAPS-TA]", "[MAPS-TP]", "[MAPS-YY]") _
- , Operator:=xlFilterValues
- 'C列の最後の行を求める。
- LNGAns = Cells(Rows.Count, 3).End(xlUp).Row
- If LNGAns > 1 Then
- 'A2〜Ctrl+End までの行を削除する。
- Range("A2").Select 'A2が無くても大丈夫?
- Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
- Selection.EntireRow.Delete
- End If
- 'フィルターを解除する。
- Selection.AutoFilter
- Range("A1").Select
- Set myFSO = CreateObject("Scripting.fileSystemObject")
- Set myTS = myFSO.CreateTextFile(argPath & "\" & TXTFileName, True)
- myTS.writeline "|*日付|*曜|*件名|*カテゴリ|"
- LastRow = Range("A1").End(xlDown).Row 'Ctrl+↓
- For lngRow = 2 To LastRow
- Cells(lngRow, 1).Select
- strDate = Cells(lngRow, 1)
- strWeekday = Format(Weekday(strDate), "aaa")
- Select Case strWeekday
- Case "日"
- strWeekday = "<font color=tomato>" & strWeekday & "</font>"
- Case "土"
- strWeekday = "<font color=green>" & strWeekday & "</font>"
- End Select
- strTitle = Cells(lngRow, 2)
- strAddress = Cells(lngRow, 2).Hyperlinks(1).Address
- strCategory = Cells(lngRow, 3)
- myTS.writeline "|" & strDate & "|" & strWeekday & "|[" & strAddress & ":title=" & strTitle & "]|" & strCategory & "|"
- Next
- myTS.Close
- MsgBox "直近記事用テキストファイルを出力しました。"
- make直近記事TextTable = True
- Exit_make直近記事TextTable:
- Exit Function
- Error_make直近記事TextTable:
- MsgBox Err.Number & Err.Description, vbCritical, mbTitle
- Resume Exit_make直近記事TextTable
- End Function