ExcelからWord #データ差し込み 処理を #デバッグ してみた Excel VBA IsDate("1200-10") が True になるので小細工してみた・・・

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

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

動画を見直すと自分の説明下手さにショックを受けつつ、
何かの参考となれば幸いです。

下記のteratailの質問
ExcelからWord #データ差し込み 処理を #デバッグ してみた
teratail.com
https://teratail.com/questions/ug68w33bvto3t0

いつもの あのあの そのその 酔っ払い解説動画は下記
www.youtube.com
https://www.youtube.com/watch?v=kd9C4CtZRJs

オープニング・質問内容 テスト実行
00:00 0.原因 日付チェックの関数 IsDate
04:40 1.対策1 書式設定で文字列 .NumberFormat でチェック
07:50 2.対策2 置き換え項目に 日 が入っていたら Like "*日*" 使用

0.原因 日付チェックの関数 IsDate
日付チェックの関数 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

---

Excel側のコード

Option Explicit

' https://teratail.com/questions/ug68w33bvto3t0 の質問コードを修正

'プログラム開始
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