Dim mcolTask As Collection

Sub Tasc_Bigin()
' セッティング-------------------------------------------------------
    dayBigin = "07/01/01"               ' 開始日付
    datBigin = TimeValue("00:00:00")    ' 開始時刻
    dayEnd = "07/01/01"                 ' 終了日付
    datEnd = TimeValue("00:00:00")      ' 終了時刻
    datInterval = TimeValue("00:00:15") ' 実行間隔(少なくとも数秒以上で）
    datTimeout = TimeValue("00:02:00")  ' 実行待機タイムアウト
    blnJustTime = True                  ' datInterval で丸めるか
    strProcName = "Ashi"              ' 実行するマクロ名
    int5 = TimeValue("00:00:05")        ' 設定した終了時間からのﾏｲﾅｽ時間
'---------------------------------------------------------------

If mcolTask Is Nothing Then
    ' 日付シリアル値を加算
    datBigin = datBigin + Application.WorksheetFunction.Text(dayBigin, "yyyy/mm/dd")
    datEnd = datEnd + Application.WorksheetFunction.Text(dayEnd, "yyyy/mm/dd") - int5
    
    If datEnd < datBigin Then
        MsgBox "開始日時が終了日時より遅くなっています。"
        Exit Sub
    End If
    
    ' 現在時刻が既に終了時刻を過ぎている場合
    If datEnd < Now() Then
        MsgBox "終了時刻を過ぎているため予約できません。", vbCritical, "終了"
        Exit Sub
    End If
    
    ' 現在時刻が開始時刻を過ぎていれば補正
    If datBigin <= Now() Then
        ' 開始時刻を datInterval で指定された値で丸めるか
        If blnJustTime Then
            datBigin = Application.Floor(Now() + datInterval, datInterval)
        Else
            datBigin = Now() + datInterval
        End If
    End If

    ' 初期化
    Set mcolTask = New Collection

    ' メイン部分
    For i = datBigin To datEnd Step datInterval
        ' 後から取り消せるようにコレクションに退避
        mcolTask.Add CStr(i) & "," & strProcName
        ' Application.Ontime で実行予約を行う
        Application.OnTime EarliestTime:=i, _
                            Procedure:=strProcName, _
                            LatestTime:=i + datTimeout, _
                            Schedule:=True
    Next i


Else
    MsgBox "既に実行中です", vbInformation
End If

        
Exit Sub
    
error:
  MsgBox "エラーが発生しました。設定された日時をご確認ください。"
        

End Sub