Excel VBAでのWord差し込み印刷を自動化について

Question

以下のコードを実行すると、
Excel内の0000-00という表記のセルがWord上で、日付の表記になってしまいます。
Excelの値には、日付として認識させたいものもあり、下記のようなコードになりましたが、前述の0000-00の表記はそのまま日付に変更せず表示したいと思っています。
どのような方法がございますか。ご教授よろしくお願いいたします。

'変数設定の指定
Option Explicit

'プログラム開始
Sub Sashikomi_Insatsu()

'変数設定
Dim i As Long, k As Long
Dim waitTime As Variant

'シート設定
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("差し込みデータ")

'エクセルの最終行と最右列を取得
Dim cmax As Long, cnt As Long
cmax = Range("A65536").End(xlUp).Row
cnt = Range("IV1").End(xlToLeft).Column

'ワード起動
Dim wdapp As Word.Application
Set wdapp = CreateObject("Word.application")
wdapp.Visible = True

'テンプレートワードのパス取得
Dim path As String
path = ThisWorkbook.path &"\マクロ用.docx"'エクセルのデータを1行ずつ処理
For i = 2 To cmax

'テンプレートワードを開く
Dim wddoc As Word.Document
Set wddoc = wdapp.Documents.Open(path)
waitTime = Now + TimeValue("0:00:03")
Application.Wait waitTime

'テンプレートワードにエクセルデータを挿入
For k = 0 To cnt - 2
With wddoc.Content.Find
.Text = ws.Range("A1").Offset(0, k).Value
.Forward = True
.Replacement.Text = ws.Range("A"&i).Offset(0, k).Value
'日付か確認
If IsDate(ws.Range("A"&i).Offset(0, k).Value) Then
.Replacement.Text = Format(ws.Range("A"&i).Offset(0, k).Value, "yyyy年m月d日")
End If

'ワードファイルを保存
On Error Resume Next '----------------------
If ws.Range("A"&i).Value <>""Then '-----
Dim str As String
str = ws.Range("A"&i).Value &".docx"wddoc.SaveAs Filename:=ThisWorkbook.path &""&str

'テンプレートワードを保存せずに閉じる
wddoc.Close savechanges:=False

'オブジェクト解放
Set wddoc = Nothing

'エクセルにデータを出力
ws.Range("I"&i).Value = Now &"処理済"End If '------------------------------------
On Error GoTo 0 '---------------------------

MsgBox "完了しました"'プログラム16｜プログラム終了
End Sub

Answer 1

一週間たったので、解決していると思いますが、少しデバッグしてみました。
原因
日付チェックの関数 IsDate で
1200-12 みたいなYYYY-MMと取れる文字列を真 Trueと判断する。
https://youtu.be/kd9C4CtZRJs?t=165
↑みたいな感じになると思います。

'日付か確認
If IsDate(ws.Range("A" & i).Offset(0, k).Value) Then  '※1 IsDateだけで判断
    .Replacement.Text = Format(ws.Range("A" & i).Offset(0, k).Value, "yyyy年m月d日")
End If

上記のように全てのデータに対して、
IsDateのチェックを行っているので、

? isdate("A123-12")
False
? isdate("1200-12")
True
? isdate("1200-13")
False

たまたま、1234-10 の ような文字列も日付だと判断してしまい、
Format関数で"yyyy年m月d日"に変換されるため。

対策1(修正案1) 動作は https://youtu.be/kd9C4CtZRJs?t=280 から見て下さい。

1.1 Excelの文字しか入らない列に書式設定で文字列と設定しておく
列を指定後、書式設定で列全体を文字列にする
1.2 日付チェックの前に
.NumberFormat "@" など、文字列か先にチェックする

? range("E2").NumberFormat
@
など、.NumberFormatをチェック後、文字列以外をIsDateで日付チェックする

                '日付か確認
                If ws.Range("A" & i).Offset(0, k).NumberFormat <> "@" Then '文字列以外の時
                    If IsDate(ws.Range("A" & i).Offset(0, k).Value) Then  '※1 IsDateだけで判断
                        .Replacement.Text = Format(ws.Range("A" & i).Offset(0, k).Value, "yyyy年m月d日")
                    End If
                End If

対策2(修正案2) 動作動画は https://youtu.be/kd9C4CtZRJs?t=470 を見て笑ってください・・・

2.1 Word元ファイルの 置き換え文字 にルールを追加する
項目名が XXXX日 と 日の文字が入っていたら(1行目の列見出し、置き換え元)
日付変換するように修正する
.Text = ws.Range("A1").Offset(0, k).Value '置換元、この文字を検索
↑この置き換えられる文字に 日 が入っていたら、変換するように細工する
If ws.Range("A1").Offset(0, k).Value Like "日" Then
など、Like演算子で、セットするデータが日付のルールかチェックするようにしてみては？

                '日付か確認
                If ws.Range("A1").Offset(0, k).Value Like "*日付*" Then '項目が日付の時
                    If IsDate(ws.Range("A" & i).Offset(0, k).Value) Then  '※1 IsDateだけで判断
                        .Replacement.Text = Format(ws.Range("A" & i).Offset(0, k).Value, "yyyy年m月d日")
                    End If
                End If

IsDateで日付かチェック可能なのですが、
1200-12 みたいなYYYY-MMと取れる文字列を真 Trueと判断する
まぁ、当たり前のお話なのかなぁ・・・

なので、追加で、書式が文字列かチェックしてみたり、
置き換え前の文字に 日 が入っているか？チェックしてみたり、、、
いろいろ デバッグしてみました。

自分のデバッグ動画 https://youtu.be/kd9C4CtZRJs を見直すと自分の説明下手さにショックを受けつつ、
何かの参考となれば幸いです。

'プログラム開始
Sub Sashikomi_Insatsu()

    '変数設定
    Dim i As Long, k As Long
    Dim waitTime As Variant
    
    'シート設定
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("差し込みデータ")
    
    'エクセルの最終行と最右列を取得
    Dim cmax As Long, cnt As Long
    cmax = Range("A65536").End(xlUp).Row
    cnt = Range("IV1").End(xlToLeft).Column
    
    'ワード起動
    Dim wdapp As Word.Application
    Set wdapp = CreateObject("Word.application")
    wdapp.Visible = True
    
    'テンプレートワードのパス取得
    Dim path As String
    path = ThisWorkbook.path & "\マクロ用.docx" 'エクセルのデータを1行ずつ処理
    
    For i = 2 To cmax
    
        'テンプレートワードを開く
        Dim wddoc As Word.Document
        Set wddoc = wdapp.Documents.Open(path)
        waitTime = Now + TimeValue("0:00:03")
        Application.Wait waitTime
        
        'テンプレートワードにエクセルデータを挿入
        'For k = 0 To cnt - 2  '改変、テストなので5固定にしてみた
        
        For k = 0 To 5  '←↑本番用に合わせて修正してください
        
            With wddoc.Content.Find
                .Text = ws.Range("A1").Offset(0, k).Value  '置換元、この文字を検索
                .Forward = True
                .Replacement.Text = ws.Range("A" & i).Offset(0, k).Value
                '日付か確認
                If ws.Range("A1").Offset(0, k).Value Like "*日*" Then '項目が*日*の時
                    If IsDate(ws.Range("A" & i).Offset(0, k).Value) Then  '※1 IsDateだけで判断
                        .Replacement.Text = Format(ws.Range("A" & i).Offset(0, k).Value, "yyyy年m月d日")
                    End If
                End If
                .Execute Replace:=wdReplaceAll  '置換実行
            End With
        Next k
        
        'ワードファイルを保存
        'On Error Resume Next '----------------------
        If ws.Range("A" & i).Value <> "" Then '-----
            Dim str As String
            str = ws.Range("A" & i).Value & ".docx"
            wddoc.SaveAs Filename:=ThisWorkbook.path & "\" & str
            
            'テンプレートワードを保存せずに閉じる
            wddoc.Close savechanges:=False
            
            'オブジェクト解放
            Set wddoc = Nothing
            
            'エクセルにデータを出力
            ws.Range("I" & i).Value = Now & "処理済"
        
        End If '------------------------------------
        On Error GoTo 0 '---------------------------
    
    Next i
    
    MsgBox "完了しました" 'プログラム16｜プログラム終了

End Sub