計劃的VBA任務和'Application.OnTime'

Question

我有以下代碼運行良好的VBA。它調用另一個VBA Sub沒有任何麻煩：

Public Sub AutoPrintMissingHistoric() 
    Dim qdf As DAO.QueryDef 
    Dim rcs As DAO.Recordset 
    Dim db As DAO.Database 
    Dim j As Integer 
    Dim flag As Boolean 
    Dim i As Long 
    Dim value_start, value_end As String 
    Dim tmp As Date 
    Dim wbRiskedge As Workbook 
    Dim wsAccueil As Worksheet 
    Dim wsHistoric As Worksheet 

    Set wbRiskedge = Workbooks(StrWbRiskedge) 
    Set wsAccueil = wbRiskedge.Worksheets(StrWsAccueil) 
    Set wsHistoric = wbRiskedge.Worksheets(StrWsHistoricMissing) 
    If FistTime = True Then 
     Call Initialisation.CleanTab 
    Else 
     FistTime = True 
     Call Initialisation.Initialisation 
    End If 
    vDelay = 5 
    Cpt = Cpt + 1 
    Set db = DBEngine.OpenDatabase(strDB) 
    Set qdf = db.QueryDefs("Get_missing_fixings") 
    If Cpt <= wsAccueil.Range(ManualListLetter & "1").End(xlDown).Row Then 
     Application.StatusBar = wsAccueil.Cells(Cpt, ManualListLetter).Text 
     qdf.Parameters("arg1") = wsAccueil.Cells(Cpt, ManualListLetter).Value 
     Set rcs = qdf.OpenRecordset 
     j = 0 
     i = 1 
     flag = False 
     If Not rcs.EOF Then 
      rcs.MoveLast 
      rcs.MoveFirst 
      While Not rcs.EOF 
       j = 0 
       While j < rcs.Fields.Count 
        If flag = False Then 
         With Cells(i, j + 1) 
          If .Value = "" Then 
           .Value = rcs(j).Name 
           .Font.Bold = True 
           .HorizontalAlignment = xlCenter 
           .VerticalAlignment = xlBottom 
          End If 
         End With 
        Else 
         Cells(i, j + 1).Value = rcs(j).Value 
        End If 
        j = j + 1 
       Wend 
       If flag = False Then 
        flag = True 
       End If 
       i = i + 1 
       rcs.MoveNext 
      Wend 
      Call ChangeMinMax(rcs.RecordCount, CellMinDate, CellMaxDate, wsHistoric) 
      Call ParseParameters 
      Call SetReutersFunction 
     End If 
     rcs.Close 
     qdf.Close 
     db.Close 
     wsHistoric.Calculate 
     Application.StatusBar = wsAccueil.Cells(Cpt, ManualListLetter).Text & " - Next Function: FindMissingValue.AutoFindMissingValue" 
     sToCall = "FindMissingValue.AutoFindMissingValue" 
     MTimeGT = Time + TimeValue("00:00:" & vDelay) 
     Application.OnTime MTimeGT, sToCall 
    End If 
End Sub 

我把這個過程的執行的計劃任務。但顯然我的代碼沒有很好的執行：FindMissingValue.AutoFindMissingValue Sub沒有被調用，因爲Excel只是關閉了。

我認爲這是因爲Application.OnTime MTimeGT, sToCall ......可能是什麼原因？

在這裏，你已經中FindMissingValue.AutoFindMissingValue

Sub AutoFindMissingValue() 
    Dim wbRiskedge As Workbook 
    Dim wsAccueil As Worksheet 
    Dim wsHistoric As Worksheet 
    Dim i, nbResult As Long 

    Set wbRiskedge = Workbooks(StrWbRiskedge) 
    Set wsAccueil = wbRiskedge.Worksheets(StrWsAccueil) 
    Set wsHistoric = wbRiskedge.Worksheets(StrWsHistoricMissing) 
    If Left(wsHistoric.Range(ReutersFormula).Text, 13) Like "Retrieving...*" = True Then 
     sToCall = "FindMissingValue.AutoFindMissingValue" 
     MTimeGT = Time + TimeValue("00:00:05") 
     Application.OnTime MTimeGT, sToCall 
     Exit Sub 
    End If 
    i = WorksheetFunction.CountA(Columns(DateColumn & ":" & DateColumn)) 
    If WorksheetFunction.CountA(Columns(ColumnResearchVResult & ":" & ColumnResearchVResult)) > 0 Then 
     wsHistoric.Range(FirstCellResearchVResult & ":" & ColumnResearchVResult & WorksheetFunction.CountA(Columns(ColumnResearchVResult & ":" & ColumnResearchVResult))).ClearContents 
    End If 
    nbResult = wsHistoric.Range(FirstResult).End(xlDown).Row 
    wsHistoric.Range(ColumnResearchVResult & LineResearchVResult - 1).Value = "Results" 
    If WorksheetFunction.CountA(Columns(DateColumn & ":" & DateColumn)) > 1 Then 
     wsHistoric.Range(FirstCellResearchVResult & ":" & ColumnResearchVResult & i).FormulaLocal = "=RECHERCHEV($" & DateColumn & "$" & LineResearchVResult & ":$" & DateColumn & "$" & i & ";" & FirstLockResult & ":$" & ValueResultColumn & "$" & nbResult & ";2;0)" 
    End If 
    Application.StatusBar = wsAccueil.Cells(Cpt, ManualListLetter).Text & " - Next Function: FindMissingValue.AutoPutResultInDb" 
    sToCall = "FindMissingValue.AutoPutResultInDb" 
    MTimeGT = Time + TimeValue("00:00:01") 
    Application.OnTime MTimeGT, sToCall 
End Sub 

Answer 1

的Application.OnTime部分是正確的，FindMissingValue.AutoFindMissingValue代碼應該沒有任何問題（5秒之後）被調用。可能發生的情況是，在這5秒鐘內，代碼將繼續運行，返回AutoPrintMissingHistoric被調用的地方，並且可能會在這5秒鐘之前關閉工作簿（儘管取決於您的確切條件，函數應該即使工作簿已關閉，也會被調用）。

您可以縮短等待時間（例如，vDelay = 1）或直接調用該函數（Call FindMissingValue.AutoFindMissingValue）。其實，我不知道你爲什麼依靠Application.OnTime來調用這個函數;使用這對於「啓動過程」（例如，「我希望我的宏每天在00:00執行」）是好的，但是在定期使用的情況下可能會驅使到「混亂的情況」。

如果沒有這個工作，請提供FindMissingValue.AutoFindMissingValue的代碼來看看它。

注意：經過一些進一步的測試/討論後，我可以確認OnTime在這些特定條件下的行爲「太不規範」。你應該想出一個不同的方法來允許你需要等待的時間，或者在不得不依靠OnTime的情況下，做一個密集的試驗和錯誤來確保它的行爲完全受到控制。這個函數預計會被調用一次（例如在某個時間打開電子表格），因此在不同的上下文中使用它時需要特別注意（比如在函數中調用它）。