(追記: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





