【コード】和暦を西暦にする

先日、以下の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

トップへ戻る