Hirdetés

Új hozzászólás Aktív témák

  • szricsi_0917

    tag

    Sziasztok

    Egy kis segítséget szeretnék kérni vba kódhoz.
    A feladat az lenne, hogy 1 vagy több lekérdezés frissítésekor kikapcsolja az automatikus számítást és ha végzett akkor kapcsolja vissza. Ez lehet a fájl megnyításakor vagy megnyított állapotban is.

    Option Explicit
    Private Sub Workbook_Open()
        ' Amikor a munkafüzet megnyílik, indítjuk a figyelőt
         Application.OnTime Now + TimeSerial(0, 0, 5), "Intelligens_lekerdezes.StartQueryMonitor"
    End Sub
    Private Sub Workbook_Activate()
        ' Ha valamiért még nem futna, indítsuk el a monitort
        Call Intelligens_lekerdezes.StartQueryMonitor
    End Sub
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
        ' Bezáráskor leállítjuk a figyelőt
        Call Intelligens_lekerdezes.StopQueryMonitor
    End Sub

    Option Explicit
    Private nextCheckTime As Date
    Private wasRunning As Boolean
    Private stableCount As Integer
    ' --- Fő figyelő ---
    Public Sub QueryMonitor()
        Dim conn As WorkbookConnection
        Dim isRunning As Boolean
        
        On Error Resume Next
        
        ' --- Ellenőrzés: van-e futó Power Query lekérdezés ---
        For Each conn In ThisWorkbook.Connections
            If InStr(1, conn.Name, "Query -", vbTextCompare) > 0 Or _
               InStr(1, conn.Name, "Lekérdezés -", vbTextCompare) > 0 Then
                If conn.Refreshing Then
                    isRunning = True
                    Exit For
                End If
            End If
        Next conn
        
        ' --- Ha bármelyik fut, állítsuk manuális számításra ---
        If isRunning Then
            If Application.Calculation <> xlCalculationManual Then
                Application.Calculation = xlCalculationManual
                Application.StatusBar = "Power Query frissítés folyamatban… képletek leállítva."
            End If
            wasRunning = True
            stableCount = 0
        Else
            ' --- Ha nincs futó lekérdezés ---
            If wasRunning Then
                stableCount = stableCount + 1
                ' Legalább 3 egymást követő ciklusig nem fut semmi
                If stableCount >= 3 Then
                    ' --- Minden kész: üzenet és automatikus számítás visszaállítása ---
                    Application.StatusBar = False
                    wasRunning = False
                    stableCount = 0
                    MsgBox "Minden lekérdezés elkészült!", vbInformation, "Kész"
                    Application.Calculation = xlCalculationAutomatic
                End If
            End If
        End If
        
        ' --- Újraütemezés 2 mp múlva ---
        nextCheckTime = Now + TimeSerial(0, 0, 2)
        Application.OnTime nextCheckTime, "Intelligens_lekerdezes.QueryMonitor"
    End Sub
    ' --- Indítás (pl. Workbook_Open) ---
    Public Sub StartQueryMonitor()
        On Error Resume Next
        StopQueryMonitor   ' Biztonsági leállítás
        wasRunning = False
        stableCount = 0
        ' --- Excel megnyitáskor automatikus számítás kikapcsolása ---
        Application.Calculation = xlCalculationManual
        nextCheckTime = Now + TimeSerial(0, 0, 2)
        Application.OnTime nextCheckTime, "Intelligens_lekerdezes.QueryMonitor"
    End Sub
    ' --- Leállítás ---
    Public Sub StopQueryMonitor()
        On Error Resume Next
        Application.OnTime nextCheckTime, "Intelligens_lekerdezes.QueryMonitor", , False
        Application.StatusBar = False
    End Sub

    A probléma mintha nem érzékelné mikor fejeződik be a lekérdezés.
    Mi lehet a probléma?

Új hozzászólás Aktív témák