まりふのひと

Excel2010/「直近記事一覧」を html から はてなダイアリー に変更するマクロを完成させた

直近記事一覧」は Excel を html で出力していたが、管理上の問題がある。

    1. 作成後、内容の間違いに気が付いても修正ができず、作り直しになる。
    2. 新しい分の追加ができない。常に作り直しになる。

そこで、はてな記法による表にするため、 Excel マクロを作っていたが、ようやく完成した。
手法としては、

  1. 2004年1月1日の記事(ブログ)に固定してある。
    • 「まりふのひと」のヘッダー または「麻里府発」の 直近記事一覧 をクリックすると、2004.01.01 の記事に移動する。
  2. はてな表組み記法 を使っている。
  3. 曜日の は色を変えてみた。
※ 注)
  • カテゴリが無い記事は無視される。
  • 削除するカテゴリは "[MAPS-77]", "[MAPS-MK]", "[MAPS-NY]", "[MAPS-TA]", "[MAPS-TP]", "[MAPS-YY]" で組み込み。
    • Criterial1 を array で指定すると、or 条件で 3っ以上指定できることが解った。
※ コード(参考)

半角“<”はタグと判断されるため、半角 “&lt;” に置き換えた。

  1. Public Function make直近記事TextTable(argPath As String) As Boolean
  2. On Error GoTo Error_make直近記事TextTable
  3. Dim mbTitle As String
  4. Dim myFSO As Object, myTS As Object
  5. Dim lngRow As Long, LastRow As Long
  6. Dim strDate As String, strTitle As String, strAddress As String
  7. Dim LastAddress As String, strCategory As String, strWeekday As String
  8.  
  9. mbTitle = "make直近記事TextTable/" & MyObjName
  10. 'フィルターでカテゴリからMiPS予定を削除する。
  11. 'Ctrl+End
  12. ActiveCell.SpecialCells(xlLastCell).Select
  13. LastAddress = ActiveCell.Address
  14. Range("A1").Select
  15. Selection.AutoFilter
  16. ActiveSheet.Range("$A$1:" & LastAddress).AutoFilter Field:=3 _
  17. , Criteria1:=Array("[MAPS-77]", "[MAPS-MK]", "[MAPS-NY]", "[MAPS-TA]", "[MAPS-TP]", "[MAPS-YY]") _
  18. , Operator:=xlFilterValues
  19. 'C列の最後の行を求める。
  20. LNGAns = Cells(Rows.Count, 3).End(xlUp).Row
  21. If LNGAns > 1 Then
  22. 'A2〜Ctrl+End までの行を削除する。
  23. Range("A2").Select   'A2が無くても大丈夫?
  24. Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
  25. Selection.EntireRow.Delete
  26. End If
  27. 'フィルターを解除する。
  28. Selection.AutoFilter
  29. Range("A1").Select
  30.  
  31. Set myFSO = CreateObject("Scripting.fileSystemObject")
  32. Set myTS = myFSO.CreateTextFile(argPath & "\" & TXTFileName, True)
  33.  
  34. myTS.writeline "|*日付|*曜|*件名|*カテゴリ|"
  35.  
  36. LastRow = Range("A1").End(xlDown).Row  'Ctrl+↓
  37.  
  38. For lngRow = 2 To LastRow
  39. Cells(lngRow, 1).Select
  40. strDate = Cells(lngRow, 1)
  41. strWeekday = Format(Weekday(strDate), "aaa")
  42. Select Case strWeekday
  43. Case "日"
  44. strWeekday = "<font color=tomato>" & strWeekday & "</font>"
  45. Case "土"
  46. strWeekday = "<font color=green>" & strWeekday & "</font>"
  47. End Select
  48. strTitle = Cells(lngRow, 2)
  49. strAddress = Cells(lngRow, 2).Hyperlinks(1).Address
  50. strCategory = Cells(lngRow, 3)
  51. myTS.writeline "|" & strDate & "|" & strWeekday & "|[" & strAddress & ":title=" & strTitle & "]|" & strCategory & "|"
  52. Next
  53. myTS.Close
  54. MsgBox "直近記事用テキストファイルを出力しました。"
  55. make直近記事TextTable = True
  56.  
  57. Exit_make直近記事TextTable:
  58. Exit Function
  59.  
  60. Error_make直近記事TextTable:
  61. MsgBox Err.Number & Err.Description, vbCritical, mbTitle
  62. Resume Exit_make直近記事TextTable
  63.  
  64. End Function