1

うまく機能している次のVBAコードがあります。Sub問題なく別のVBAを呼び出しています：

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ません。Excel が閉じるだけなので、Sub は呼び出されません。

私はそれが原因だと思います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、集中的な試行錯誤を行って、その動作が完全に制御されていることを確認する必要があります。この関数は 1 回呼び出されることが想定されているため (たとえば、特定の時間にスプレッドシートを開くなど)、さまざまなコンテキストで使用する場合 (この例のように、関数内で呼び出す場合) は十分に注意する必要があります。

于 2013-08-16T09:25:24.563 に答える