【Excel VBA】Inputboxでキャンセルした時に終了するようにしたい

Question

前提

VBAで今日現在および任意の日の組織リストを出力するマクロを作っています。
ボタンをクリックするとダイアログが開き、任意の日付(例：2023/1/1)を入力して「OK」をクリックすると、その日の時点での組織リストが出力されるようにするマクロです。

該当のソースコード

「組織マスター」シートおよび「組織DB」シートを参照して、「現在の組織」シートに今日現在の組織リストを作成するコードです。

【組織マスター】

【組織DB】

【現在の組織】

Sub sosikikosin(d As Date)
    '今日現在の組織リストを出力する
    Dim today_d As Date, str_d As Date, end_d As Date
    Dim shisha As String, bu As String, ka As String, kakari As String, syozoku As String
    Worksheets("現在の組織").Activate
    n = Worksheets("現在の組織").Cells(Rows.Count, 1).End(xlUp).Row
    If n > 2 Then
        Worksheets("現在の組織").Range(Cells(3, 1), Cells(n, 8)).ClearContents
        Worksheets("現在の組織").Range(Cells(3, 1), Cells(n, 8)).Borders.LineStyle = xlLineStyleNone
    End If
    For R = 2 To Worksheets("組織DB").Cells(Rows.Count, 1).End(xlUp).Row
        With Worksheets("組織DB")
            today_d = d
            str_d = .Cells(R, 1)
            end_d = .Cells(R, 2)
            shisha = .Cells(R, 3)
            bu = .Cells(R, 4)
            ka = .Cells(R, 5)
            kakari = .Cells(R, 6)
            syozoku = .Cells(R, 7)
        End With
        If (str_d <= today_d And today_d <= end_d) Or (str_d <= today_d And end_d = 0) Then
            With Worksheets("組織マスター")
                Set rcd_shisha = .Range("a:a").Find(shisha, lookat:=xlWhole)
                Set rcd_bu = .Range("c:c").Find(bu, lookat:=xlWhole)
                Set rcd_ka = .Range("e:e").Find(ka, lookat:=xlWhole)
                Set rcd_kakari = .Range("g:g").Find(kakari, lookat:=xlWhole)
                Set rcd_syozoku = .Range("t:t").Find(syozoku, lookat:=xlWhole)
                code_shisha = rcd_shisha.Offset(0, 1)
                code_syozoku = rcd_syozoku.Offset(0, 1)
            End With
            With Worksheets("現在の組織")
                n = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                .Cells(n, 1) = R
                .Cells(n, 2) = shisha
                .Cells(n, 3) = bu
                .Cells(n, 4) = ka
                .Cells(n, 5) = kakari
                .Cells(n, 6) = code_shisha
                .Cells(n, 7) = syozoku
                .Cells(n, 8) = code_syozoku
            End With
        End If
    Next R
    n = Worksheets("現在の組織").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("現在の組織").Range("A2:h" & n).Sort _
    Key1:=Range("a2"), Order1:=xlAscending, _
    Header:=xlYes
    Worksheets("現在の組織").Range("A2:h" & n).Borders.LineStyle = xlContinuous
    Worksheets("現在の組織").Range("a1") = d & "現在組織リスト"
End Sub

「menu」シートにボタンを作成、クリックするとダイアログが開き、任意の日付(例：2023/1/1)を入力して「OK」をクリックすると、その日の時点での組織リストが出力されるコードです。
【ダイアログ】

Sub ninikosin()
    '任意の日の組織リストを出力する
    Application.ScreenUpdating = False
        Dim d As Date 
        d = InputBox("基準日を入力(記入例：1900/1/1)")
        Call Module1.sosikikosin(d)
        Dim TargetBook As Workbook
        Worksheets("現在の組織").Copy
        Set TargetBook = ActiveWorkbook
        ThisWorkbook.Activate
        d = Date
        Call Module1.sosikikosin(d)
        Worksheets("menu").Activate
        TargetBook.Activate
    Application.ScreenUpdating = True
End Sub

発生している問題・エラーメッセージ

ダイアログに正しく日付を入力して「OK」をクリックすると別ファイルで出力されますが、
「キャンセル」および右上の「×」をクリックすると以下のエラーメッセージが発生してしまいます。
また、何も入力しないで「OK」をクリックした場合も同様のエラーメッセージが発生します。

実行時エラー'13':
型が一致しません。

デバックを確認すると、5行目でエラーが発生していました。
（「d=」付近にカーソルを合わせると「d = 0:00:00」と表示されます）

実現したいこと

• 「キャンセル」および右上の「×」をクリックしてそのままダイアログを終了させたい。
• 何も入力しないで「OK」をクリックした場合、「数値を入力してください」というメッセージボックスを表示させたい

試したこと

キャンセルを選んだときの処理に関するコードを調べて、参考になりそうなサンプルコードを見つけました。

Sub InputBox関数で必ず数値を入力してもらう_キャンセル処理あり()
　Dim ans As String　' InputBoxの戻り
　Dim flg As Boolean　' 数値かどうかの判定フラグ
　flg = False
　Do
　　ans = InputBox("数値を入力してください。")
　　If StrPtr(ans) = 0 Then Exit Sub　' キャンセル時に終了
　　If IsNumeric(ans) Then flg = True
　Loop Until flg = True

　MsgBox CDbl(ans)
End Sub

Sub ninikosin()の直下に入力するだけでは当然エラーになり、2行目～11行目を、Sub ninikosin()の4行目下に挿入するのを試してみましたが、この場合、何も入力せず「OK」を押したとき「数値を入力してください」のメッセージボックスが表示されないという別の問題が発生してしまいました。
キャンセル時に終了できるように、アドバイスいただければと思います。
よろしくお願いいたします。

補足情報（FW/ツールのバージョンなど）

PC：Windows11
ソフト：Microsoft365 Excel

Comments

[meg_]

> 何も入力せず「OK」を押したとき「数値を入力してください」のメッセージボックスが表示されないという別の問題が発生してしまいました。
キャンセルボタンをクリックしたときのエラーは解消された、と理解して良いのでしょうか？

[koburon]

コメントありがとうございます。
いいえ、キャンセルをクリックした場合、引き続きエラーは発生してしまいます。

Answer 1

キャンセル又は×クリック時、処理を終了します。
未入力時、エラーメッセージを表示後、再入力します。
日付入力時、次の処理へ進みます。（日付の妥当性チェックは行っていません）
以下のようにしてください。

Sub ninikosin()
'任意の日の組織リストを出力する
    Application.ScreenUpdating = False
    Dim d As Date
    Dim dval As String
    Dim flag As Boolean
    flag = False
    Do While flag = False
        dval = InputBox("基準日を入力(記入例：1900/1/1)")
        If StrPtr(dval) = 0 Then
            'キャンセル又は右上の×をクリックした場合
            Exit Sub
        ElseIf dval = "" Then
            'なにも入力しないでOKをクリックした場合
            MsgBox ("未入力です")
        Else
            '上記以外
            '入力日付は正しいものとする
            '（必要があれば入力日付のチェックを行い、エラーなら再入力するように変えてください）
            d = CDate(dval)
            flag = True
        End If
    Loop
    Call Module1.sosikikosin(d)
    Dim TargetBook As Workbook
    Worksheets("現在の組織").Copy
    Set TargetBook = ActiveWorkbook
    ThisWorkbook.Activate
    d = Date
    Call Module1.sosikikosin(d)
    Worksheets("menu").Activate
    TargetBook.Activate
    Application.ScreenUpdating = True
End Sub

Comments

[koburon]

回答ありがとうございます。
実行したところ、問題なく動作しました。
こちらをベストアンサーとさせていただきます。
ありがとうございました。

Answer 2

以下のようにしてください。

        Dim dval As String
        dval = InputBox("基準日を入力(記入例：1900/1/1)")
        If StrPtr(dval) = 0 Then
            'キャンセル又は右上の×をクリックした場合
            MsgBox ("キャンセル")
        ElseIf dval = "" Then
            'なにも入力しないでOKをクリックした場合
            MsgBox ("未入力")
        Else
            '上記以外
            MsgBox ("入力")
        End If

Comments

[koburon]

回答ありがとうございます。
キャンセル又は右上の×をクリックした場合となにも入力しないでOKをクリックした場合でメッセージボックスを表示させることができました。
ただし、特定を日付を入力してOKをクリックした場合、"入力"とメッセージボックスが表示されるのみなので、
入力した日の組織リストを出力するようにしたいのですので、どのように途中に組み込めば良いでしょうか。

試しに、11行目を上述のSub ninikosin()の6行目から14行目に入れ替えて「d」を「dval」に直し実行したところ、
「ByRef引数の型が一致しません」というエラーが発生してしまいました。宣言する変数に関するエラーだと思いますが、原因がよく分からないです。

原因をご存じでしたら、アドバイスいただければと思います。
よろしくお願いいたします。

[tatsu99]

別途、回答を書きました。そちらを参照してください。