選択した文字列を入力した平成日付に置換するマクロ

「まりふの質問箱」No.18に、次のような質問がある。

　書類に年月日が記されておりその項目欄に数字（Ｈ１９　１２　１０）を入れたら年月日が横に移動します。年月日を移動しないように固定する事は出来ますか？

題名が“Excel”だったので、てっきり Excel だと思って「返信」したが、話を聞くと Word だった。
「Word では無理です」と答えたものの、今朝になって、ヒョッとしてマクロで出来るかも‥‥と思い挑戦した。

サンプルデータ

SampleData
- 圧縮（zip形式）フォルダ。クリックするとダウンロードできます（たぶん）
- 解凍すると、「平成日付に置換するマクロ」（Microsoft Word 文書）が出来ます。

全て自己責任で試す

結果は保証しません。マクロを使えるよう設定を変更する場合も含め、全て自分の責任です。

解凍して得られた「平成日付に置換するマクロ」を開きます。
- このメッセージが出た場合は‥‥
  - ［OK］をクリックします。
  - ［ツール］メニュー ⇒［マクロ］⇒［セキュリティ］をクリックします。
  - ［セキュリティレベル］タブの、“中”を選択（クリック）し、［OK］をクリックします。
  - 一旦 Wordを終了し、再度、「平成日付に置換するマクロ」を開きます。
- このメッセージが出た場合は‥‥
  - ［マクロを有効にする］をクリックします。
日付を選択します。
［ツール］メニュー ⇒［マクロ］⇒［マクロ］をクリックします。
［平成日付に置換する］を選択（クリック）し、［実行］をクリックします。
日付の入力を求めてきますので、
- 日付を、原則として平成の年月日を各２桁で入力（例：191221）し、［Enter］キーを押下または［OK］をクリックします。
- 入力は全角でもＯＫです。但し、「確定」の［Enter］を忘れないようにします。
- 表示どおり（今日の日付）でいい場合は、そのまま［Enter］キーを押下または［OK］をクリックします。
Word文書の画面に戻ったら、日付を確認してください。

質問は‥‥

コメントではなく、「まりふの質問箱」でお願いします。

［マクロを有効にする］にしたからには、今後、これに伴う責任は、全て貴方にあります。
このマクロは、この文書でしか使えません。
他の文書でも使いたい場合は、この文書を開いた後、他の文書を開きます。
このパソコンでは常に使いたい場合は、それなりの方法があります。
このマクロを起動するもっと簡単な方法（ツールバーにボタンを追加する）があります。
自分のニーズに合わせ改修することは、そんなに難しいことではありません。
- 例えば、「数字は半角表示にする」とか「西暦で入力するので平成で表示する」などです。

ソース

'概要：選択した文字列を入力した日付に置き換える
'　　：(1)入力はインプットボックスから行う。
'　　：(2)入力は、平成年月日の数字６桁。半角/全角は問わない。
'　　：(3)結果の日付は全角表示となる。
'履歴：H19.12.21    初版
Sub 平成日付に置換する()
On Error GoTo Err_平成日付に置換する
Dim mbTitle As String
Dim lngAns As Long
Dim strAns As String, strDate As String
Dim dd As Long, mm As Long, yy As Long, n As Long

    mbTitle = "平成日付に置換するマクロ"
    strAns = InputBox("平成年月日を入力してください。", mbTitle, Format(Now, "eemmdd"))
    If strAns = "" Then Exit Sub
    strAns = StrConv(strAns, vbNarrow)
    If (Not IsNumeric(strAns)) Or (Len(strAns) < 3) Then
        MsgBox "日付の指定に不具合があります。", vbExclamation, mbTitle
        Exit Sub
    End If
        '日を切り取る
    lngAns = Val(Right(strAns, 2))
    If lngAns >= 1 And lngAns <= 31 Then
        dd = lngAns
        strAns = Left(strAns, Len(strAns) - 2)
    Else
        dd = Val(Right(strAns, 1))
        strAns = Left(strAns, Len(strAns) - 1)
    End If
        '月を切り取る
    lngAns = Val(Right(strAns, 2))
    If lngAns >= 1 And lngAns <= 12 Then
        mm = lngAns
        yy = Val(Left(strAns, Len(strAns) - 2))
    Else
        mm = Val(Right(strAns, 1))
        yy = Val(Left(strAns, Len(strAns) - 1))
    End If
    strDate = "平成" & CStr(yy) & "年" & CStr(mm) & "月" & CStr(dd) & "日"
    strDate = StrConv(strDate, vbWide)
    Selection.TypeText Text:=strDate

Exit_平成日付に置換する:
    Exit Sub
    
Err_平成日付に置換する:
    MsgBox "日付の入力に不具合があります。" & vbCrLf & vbCrLf _
            & Err.Number & "/" & Err.Description, vbCritical, mbTitle
    Resume Exit_平成日付に置換する
End Sub