【Word VBA】和暦を西暦にするWordマクロ(令和対応版)

2019年5月1日

以前紹介した「【コード】和暦を西暦にするWordマクロ(変更履歴オン版)」を新元号の「令和」にも対応するように作りかえました。

いずれFormat関数が令和にも対応すると思うのですが、令和元年5月1日現在では対応していないようなので、マクロにしてみました。

このマクロでできること

令和の日付を西暦で英語表記に変換します。処理した箇所は黄色の蛍光ペンで着色します。

(処理前)

(処理後)

マクロの解説

実はFormat関数を使っています。Format関数というのは、元号が変わってもカウントをし続けているようです。

たとえば、以下のように西暦が表示されるのです。

平成元年1月1日は存在していないのですが、Format関数を使って変換すると日付が表示されます。エラーになりません。

(処理前)

Forma関数で変換後)

同じく、昭和94年なんて存在していませんが入力してみると。。。そうです。昭和94年は今年なのです。

(処理前)

(昭和94年はForma関数の変換結果、令和元年はマクロを使った変換結果)

この性質を使って、令和を平成の年に換算してFormat関数で西暦に変換しているということなのです(65行目~74行目)。

(後に追記)
Format関数が令和に対応した後も使えるように66行目、72~74行目を追記しました。

マクロ


Sub 和暦を西暦に変換4()
 
 Dim blnShowRevisions As Boolean
 Dim myDoc As Document
 Dim myRange As Range
 Dim Pos_Start As Integer
 Dim myText As String
 Dim myYear As Integer
 
 Set myDoc = ActiveDocument
 
 With myDoc
  '変更履歴の表示状態の設定
  blnShowRevisions = .ShowRevisions '設定保存
  .ShowRevisions = False '表示オフ
 End With
 
 '-------------------------------------------
 '平成までの処理
 '-------------------------------------------
 Set myRange = myDoc.Range(0, 0)
 
 With myRange.Find
  .Text = "[明大昭平][治正和成][0-90-9元]{1,2}年[0-90-9]{1,2}月[0-90-9]{1,2}日"
  .Forward = True
  .Format = False
  .Wrap = wdFindStop
  .MatchCase = False
  .MatchWholeWord = False
  .MatchByte = False
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchFuzzy = False
  .MatchWildcards = True
  Do While .Execute = True
   With myRange
    .HighlightColorIndex = wdYellow
    .Text = Format(.Text, "mmmm d, yyyy")
    .Collapse direction:=wdCollapseEnd
    DoEvents
   End With
  Loop
 End With

 '-------------------------------------------
 '令和の処理
 '-------------------------------------------
 Set myRange = myDoc.Range(0, 0)
 
 With myRange.Find
  .Text = "令和[0-90-9元]{1,2}年[0-90-9]{1,2}月[0-90-9]{1,2}日"
  .Forward = True
  .Format = False
  .Wrap = wdFindStop
  .MatchCase = False
  .MatchWholeWord = False
  .MatchByte = False
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchFuzzy = False
  .MatchWildcards = True
  Do While .Execute = True
   With myRange
    .HighlightColorIndex = wdYellow
    myText = .Text
    If Format(myText, "mmmm d, yyyy") = myText Then '追記(Format関数が令和に未対応)
     myText = Replace(myText, "元年", "1年")
     myText = Replace(myText, "令和", "")
     Pos_Start = InStr(1, myText, "年")
     myYear = CInt(Left(myText, Pos_Start - 1)) + 30
     .Text = Format("平成" & myYear & Mid(myText, Pos_Start), "mmmm d, yyyy")
    Else                      '追記(Format関数が令和に対応済み)
     .Text = Format(myText, "mmmm d, yyyy")   '追記
    End If                     '追記
    .Collapse direction:=wdCollapseEnd
    DoEvents
   End With
  Loop
 End With
 
 '変更履歴の表示を元に戻す
 myDoc.ShowRevisions = blnShowRevisions
 
 '-------------------------------------------
 '後処理
 '-------------------------------------------
 Set myRange = Nothing
 Set myDoc = Nothing
 
End Sub

関連記事

日本の新元号に関する Office の更新プログラム

-コード
-, ,