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的情况下，进行密集的反复试验，以确保其行为完全受到控制。预计此函数将被调用一次（例如，在特定时间打开电子表格），因此在不同的上下文中使用它时必须要大量注意（例如：在函数内调用它）。

预定的VBA任务和'Application.OnTime'

1 个答案: