如何在 10 秒后自动停止运行的 Sub

Question

为什么这段代码在 10 秒后不停止，我现在按照建议做这在 10 秒后不停止

Sub test()
  Application.OnTime Now + TimeValue("00:00:08"), "TerminateExecution"
  ChangeDoubleToDate
End Sub

Sub TerminateExecution()
  End
End Sub

Sub ChangeDoubleToDate()
  Dim ii As Long
  Sheets.Add
  ActiveSheet.Name = "Example"
  Range("A:E").ColumnWidth = 15
  Range("A:E").ClearContents
  Range("A1").Select
  For ii = 20190101 To 20191234
  ActiveCell.Value = ii
  ActiveCell.Offset(0, 1).Range("A1").Select
  ActiveCell.FormulaR1C1 = "=MID(RC[-1],1,4)" 
  ActiveCell.Offset(0, 1).Range("A1").Select
  ActiveCell.FormulaR1C1 = "=MID(RC[-2],5,2)"
      ActiveCell.Offset(0, 1).Range("A1").Select
      ActiveCell.FormulaR1C1 = "=MID(RC[-3],7,2)"
      ActiveCell.Offset(0, 1).Range("A1").Select
      ActiveCell.FormulaR1C1 = "=DATE(RC[-3],RC[-2],RC[-1])"
      ActiveCell.Offset(1, -4).Range("A1").Select
      DoEvents
      Next
      Application.DisplayAlerts = False
      Sheets("Example").Delete
      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
' ...