1

我有以下运行良好的VBA代码。它调用另一个 VBASub没有任何麻烦：

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
4

1 回答 1

1

该Application.OnTime部分是正确的，FindMissingValue.AutoFindMissingValue应该毫无问题地调用（5 秒后）。可能发生的情况是，在这 5 秒期间，代码继续运行，返回到AutoPrintMissingHistoric调用位置，并且工作簿可能会在这 5 秒过去之前关闭（尽管根据您的确切条件，该函数应该是即使工作簿已关闭，也会调用）。

您可以减少等待时间（vDelay = 1例如 ）或直接调用函数（Call FindMissingValue.AutoFindMissingValue）。实际上，我不确定您为什么要依靠Application.OnTime;来调用该函数。使用它对于“启动进程”很好（例如，“我希望我的宏每天在 00:00 执行”），但如果定期使用，可能会导致“混乱情况”。

如果这些都不起作用，请提供代码FindMissingValue.AutoFindMissingValue以查看它。

注意：经过一些进一步的测试/讨论，我可以确认OnTime在这些特定条件下的行为“太不规则”。你应该想出一个不同的方法来允许你需要的等待时间，或者在不得不依赖的情况下OnTime，做一个密集的试错，以确保它的行为完全受到控制。该函数预计会被调用一次（例如，在特定时间打开电子表格），因此在不同的上下文中使用它时必须非常注意（例如：在函数中调用它）。

于 2013-08-16T09:25:24.563 回答