自称イクメン系隠れオタク日記

自称イクメン系隠れオタク日記

島根出身の自称イクメンがネットの片隅でひっそりと隠れてオタクを暴露します。

Excelマクロのススメ Part2

先日、自分のHTML日記のURLをLINEに貼り付けて、友人に公開しようとしたら、
文字化けて読めないことが発覚。
どうやら、文字エンコーディング指定を記載していなかったことが原因っぽい。
通常のブラウザだと、結構自動で判別してくれるから、顕在化しないんだけど、
LINEのブラウザはおバカっぽいな!
などと、LINEのせいにしつつも、HTMLのお作法的にはイマイチなので、
ちょっと修正してみることに。
で、せっかくなので、他に対応したかったことも含めて、
前に紹介したExcelマクロを少し改造して、対応してみます。


ただし、前回同様、無駄に長いだけで大した面白みもないので、それでも良い方だけ先にお進みください。(w


まずは、要求事項とその実現方法を整理してみる。

# 要求事項 実現方法
1 LINEのブラウザでも文字化けなく表示したい。 TITLEタグの下に文字エンコーディング指定のMETAタグを挿入する。
2 はてなブログっぽく、日付タイトルをクリックしたらその日の日記に飛びたい。 日付タイトルにHREF属性を付けたAタグを挿入する。
3 #2において、一部赤色のフォントがあるため、リンクの文字修飾はOFFにしたい。 Aタグにはstyle属性を付ける。


これを対応前と対応後の成果物イメージで記載すると、こんな感じ。

(※上略)
<HEAD>
<TITLE>ちょぉ不定期日記 2000/04</TITLE>
</HEAD>
(※中略)
<A NAME="20000430"><FONT SIZE=6><B>2000年4月30日(日)</B></FONT><BR></A>
<BR>
 マリンメッセにコミケ襲撃。コミケについてはさして特筆することはなし。<BR>
 一つ言えることは、使ったお金は入場料だけということくらいか・・・。<BR>
(※中略)
<HR>
<A NAME="20000427"><FONT SIZE=6><B>2000年4月27日(木)</B></FONT><BR></A>
<BR>
 今日はゼミあったんで、サークル休んだ。<BR>
 ちゅーか、今日のこと誰も教えてくれない。電話くらいあっても良いと思うんだけどな〜。<BR>
(※下略)

↓修正後

(※上略)
<HEAD>
<TITLE>ちょぉ不定期日記 2000/04</TITLE>
<META http-equiv="Content-Type" content="text/html; charset=Shift_JIS" />
</HEAD>
(※中略)
<A NAME="20000430" HREF="#20000430" style="color:white;text-decoration:none"><FONT SIZE=6><B>2000年4月30日(日)</B></FONT><BR></A>
<BR>
 マリンメッセにコミケ襲撃。コミケについてはさして特筆することはなし。<BR>
 一つ言えることは、使ったお金は入場料だけということくらいか・・・。<BR>
(※中略)
<HR>
<A NAME="20000427" HREF="#20000427" style="color:white;text-decoration:none"><FONT SIZE=6><B>2000年4月27日(木)</B></FONT><BR></A>
<BR>
 今日はゼミあったんで、サークル休んだ。<BR>
 ちゅーか、今日のこと誰も教えてくれない。電話くらいあっても良いと思うんだけどな〜。<BR>
(※下略)


で、これを実現するために、組んだマクロがこんな感じ。

Sub Diary_Conv2()
    Dim intFIn, intFOut As Integer
    Dim strRec As String
    Dim strFileName As String
    Dim lngStPt, lngEdPt As Long
    Dim strName, strColor As String

    '先頭のファイル名の取得
    strFileName = Dir(ThisWorkbook.Path & "\diary\", vbNormal)
    
    'ファイルが見つからなくなるまで繰り返す
    Do While strFileName <> vbNullString
        
        'HTMLファイル以外は読み飛ばす
        If InStr(1, strFileName, ".html") > 0 Then
        
            '入力ファイルをOPEN
            intFIn = FreeFile
            Open ThisWorkbook.Path & "\diary\" & strFileName For Input As #intFIn
            
            '出力ファイルをOPEN
            intFOut = FreeFile
            Open ThisWorkbook.Path & "\output\" & strFileName For Output As #intFOut
            
            'ファイルのEOFまで繰り返す
            Do Until EOF(intFIn)
                
                '改行までをレコードとして読み込む
                Line Input #intFIn, strRec
                
                '文字エンコーディング指定を追加
                If InStr(1, strRec, "</TITLE>") > 0 Then
                    strRec = strRec & vbCrLf & "<META http-equiv=" & Chr(34) & "Content-Type" & Chr(34) _
                        & " content=" & Chr(34) & "text/html; charset=Shift_JIS" & Chr(34) & " />"
                End If
                
                '日付タイトルの部分の場合のみレコードを編集
                If InStr(1, strRec, "<FONT SIZE=6><B>") > 0 And _
                        InStr(1, strRec, "年") > 0 And InStr(1, strRec, "月") > 0 Then
                    
                    'NAMEの値を取得
                    lngStPt = InStr(1, strRec, Chr(34))
                    lngEdPt = InStr(lngStPt + 1, strRec, Chr(34))
                    strName = Mid(strRec, lngStPt + 1, lngEdPt - lngStPt - 1)
                                        
                    'Colorの値を取得
                    lngStPt = InStr(1, strRec, "COLOR=") + 6
                    If lngStPt = 6 Then
                        strColor = "white"
                    Else
                        lngEdPt = InStr(lngStPt, strRec, ">") - 1
                        strColor = Mid(strRec, lngStPt, lngEdPt - lngStPt + 1)
                    End If
                    
                    'HREF属性を付与
                    strRec = Replace(strRec, "<A NAME=" & Chr(34) & strName & Chr(34), "<A NAME=" & Chr(34) & strName & Chr(34) & _
                                " HREF=" & Chr(34) & "#" & strName & Chr(34) & " style=" & Chr(34) & "color:" & strColor & ";text-decoration:none" & Chr(34))
                
                End If
            
                'レコードを出力
                Print #intFOut, strRec
            Loop
            
            'ファイルをCLOSE
            Close #intFIn
            Close #intFOut
            
        End If
        
        '次のファイル名を取得
        strFileName = Dir()
    Loop

End Sub


というわけで、無事にLINEのブラウザで参照が可能となりましたとさ。めでたしめでたし。(w
ちなみに、前回同様、ココに載せたへっぽこマクロのソースは、別に他で好きに使っても構いませんが、
ダメ出しやバグ等の文句は受け付けませんのでご了承ください。(w