(追記:2013/04/22) さらに正確に変換するマクロを作りました。 以下の記事をご覧ください。 【コード】和暦を西暦にするWordマクロ(その2)
先日、以下の2つのマクロをご紹介しました。
今回は、上記と同じようにチェック用に使えるかも?の和暦を西暦に変換するマクロをご紹介します。
<目次>
このマクロでできること
和暦(明治、大正、昭和、平成)を西暦に変換します。
明治元年から5年までは、西暦と完全一致していないため、蛍光ペンを青にします。
また、元年は、複数の西暦を有するため、要注意と言うことで蛍光ペンを赤で着色します。
上記以外で、変換した西暦は、黄色の蛍光ペンで着色します。
マクロの解説
和暦の元号を探す方法は、水野麻子さんのブログのワイルドカードを利用させていただきました。
このブログ記事で、
[明大昭平][治正和成][0-9元]{1,2}年
が紹介されています。
少し改造して、数値を全角と半角いずれにも対応させてみました。
[明大昭平][治正和成][0-90-9元]{1,2}年
前回の記事で西暦を和暦に変換したときと同様に、Format関数を用いています。
Format関数は、ただ元号をいれただけでは変換してくれないため、カレンダーであると認識してもらうために、元号の後に"1月1日"を追加してから変換しています。
マクロ
Sub 和暦を西暦に変換() Dim myRange As Range Dim myNum As String ActiveDocument.Range.HighlightColorIndex = wdNoHighlight Set myRange = ActiveDocument.Range(0, 0) With myRange.Find .Text = "[明大昭平][治正和成][0-90-9元]{1,2}年" .Forward = True .Wrap = wdFindStop .MatchWildcards = True End With Do While myRange.Find.Execute = True myNum = myRange.Text Select Case myNum Case "明治元年" myNum = "明治1年" myRange.HighlightColorIndex = wdBlue Case "明治1年" myRange.HighlightColorIndex = wdBlue Case "明治2年" myRange.HighlightColorIndex = wdBlue Case "明治2年" myRange.HighlightColorIndex = wdBlue Case "明治3年" myRange.HighlightColorIndex = wdBlue Case "明治3年" myRange.HighlightColorIndex = wdBlue Case "明治4年" myRange.HighlightColorIndex = wdBlue Case "明治4年" myRange.HighlightColorIndex = wdBlue Case "明治5年" myRange.HighlightColorIndex = wdBlue Case "明治5年" myRange.HighlightColorIndex = wdBlue Case "大正1年" myRange.HighlightColorIndex = wdRed Case "昭和1年" myRange.HighlightColorIndex = wdRed Case "平成1年" myRange.HighlightColorIndex = wdRed Case "大正1年" myRange.HighlightColorIndex = wdRed Case "昭和1年" myRange.HighlightColorIndex = wdRed Case "平成1年" myRange.HighlightColorIndex = wdRed Case "大正元年" myNum = "大正1年" myRange.HighlightColorIndex = wdRed Case "昭和元年" myNum = "昭和1年" myRange.HighlightColorIndex = wdRed Case "平成元年" myNum = "平成1年" myRange.HighlightColorIndex = wdRed Case Else myRange.HighlightColorIndex = wdYellow End Select myRange.Text = StrConv(Format(myNum & "1月1日", "yyyy"), vbNarrow) myRange.Collapse direction:=wdCollapseEnd Loop End Sub