Как автоматически остановить работу саба через 10 секунд

Question

'Почему этот код не останавливается через 10 секунд «Я сейчас делаю, как предполагалось, это не останавливает через 10 секунд Суб тест () Application.OnTime Now + TimeValue ("00:00:08"), "TerminateExecution" ChangeDoubleToDate End Sub Sub TerminateExecution () Конец End Sub Sub ChangeDoubleToDate () Дим и так долго Sheets.Add ActiveSheet.Name = "Пример" Диапазон («A: E»). ColumnWidth = 15 Range ( "A: E") ClearContents. Range ( "A1"). Выберите Для ii = 20190101 до 20191234 ActiveCell.Value = ii ActiveCell.Offset (0, 1) .Range («A1»). Выбрать ActiveCell.FormulaR1C1 = "= MID (RC [-1], 1,4)" ActiveCell.Offset (0, 1) .Range («A1»). Выбрать ActiveCell.FormulaR1C1 = "= MID (RC [-2], 5,2)" ActiveCell.Offset (0, 1) .Range («A1»). Выбрать ActiveCell.FormulaR1C1 = "= MID (RC [-3], 7,2)" ActiveCell.Offset (0, 1) .Range («A1»). Выбрать ActiveCell.FormulaR1C1 = "= ДАТА (RC [-3], RC [-2], RC [-1])" ActiveCell.Offset (1, -4) .Range («A1»). Выбрать DoEvents следующий Application.DisplayAlerts = False Листы ( «Пример»). Удалить Application.DisplayAlerts = True End Sub

Answer 1

Sub Test()

    Application.OnTime Now + TimeValue("00:00:10"), "TerminateExecution"
    MainContent

End Sub

Sub TerminateExecution()

    End

End Sub

' Add the rest procedures you need unchanged below
' ...