VBA - přerušení běhu makra Vyřešeno

[VALL]

Ahoj, mám kód, který vepíše do zadané oblasti hodnoty. Na základě změn hodnot v dané oblasti se spustí dotaz na pozadí sešitu Excel a importují se data z databáze.
Já jsem rozšířil kód tak, že:
1. Vložím hodnoty do dané oblasti - má se spustit dotaz na pozadí
2. další část kódu vkládá hodnoty z tabulky importu dat.

Celý problém je v tom, že po bodu 1 se nespustí dotaz na pozadí a neimportuje data. Data jsou importovány až po skončení celého kódu, tzn., bodu 2, což je pozdě.
Hledám řešení, jak kód přerušit, aby se mohl spustit dotaz na pozadí pro import dat a poté kód dokončit. Tzn., bod 1 - přerušení - bod2 - konec.

Kód:

Kód: Vybrat vše

Sub RozFiltr()
'BOD 1
'Vyfiltruje moduly požadovaného Projektu
'----------------------------------------------------
    Range("tab.ModulProjekt").AdvancedFilter Action:=xlFilterCopy, CriteriaRange _
        :=Range("KriteriaFiltr"), CopyToRange:=Sheets("csl_ProjektySledovat").Range("I1"), Unique:=True

    Range("tab.ModulProjekt").AdvancedFilter Action:=xlFilterCopy, CriteriaRange _
        :=Range("KriteriaFiltr"), CopyToRange:=Sheets("csl_ProjektySledovat").Range("J1"), Unique:=True

'BOD2
'Vyfiltruje data pro vybraný projekt
'----------------------------------------------------
  Sheets("VykazPrace").Range("A9").Select
   Range(Selection, Selection.End(xlToRight)).Select
   Range(Selection, Selection.End(xlDown)).Select
  Selection.ClearContents

    Range("tab.viM002z[#all]").AdvancedFilter Action:=xlFilterCopy, _
      CopyToRange:=Range("VykazPrace_Kriteria"), Unique:=True

  Range("a9").Select
End Sub


[Reklama]

[Azuzula]

Pokud by šlo jen o přerušení běhu makra, tak bych bod1 a bod2 rozdělila do dvou maker a to druhé volala metodou OnTime.

Kód: Vybrat vše

Application.OnTime Now + TimeValue("0:00:02"), "volane_makro"

Ale ve vašem příkladu je jen filtrace a mazání, takže předpokládám, že se makro importu volá při nějaké změně na listu? Takže bych spíš volala druhé makro (bod2) na konci importu což by bylo určitě nejjednodušší bez zbytečné časové prodlevy.

[VALL]

Ono jde o to, že první makro vyvolá událost v sešitě, který otevře SQL dotaz a ten importuje data z SQL Serveru. Pokud to makro nepřeruším před bodem 2, tak se data naiportují až po skončení makra, a to je pozdě, protože na výsledné listině jsou data neaktuální.

--- Doplnění předchozího příspěvku (12 Čer 2012 15:57) ---

Díky, On time funguje dobře. Mám zde jen obavu, že pokud bude trvat spuštění dotazu na pozadí déle než jsem nastavil onTime, tak se data neaktualizují.

Toto asi ošetřit nejde?

[d1amond]

Import bych spouštěl a kontroloval funkcí. Funkce se může volat z procedury a po jejím skončení pokračuje procedura dál.

[Azuzula]

Nevím jak funguje dotaz na SQL, ale nedá se na konci toho dotazu volat další makro? Tedy ten Bod2?
Případně, dalo by se do toho SQL dotazu na konec přidat nějaký zápis do pomocné buňky v excelu? Pak by se dalo třeba s pomocí sheet_change kontrolovat ta buňka na přítomnost poznámky o ukončení dotazu a spuštění makra.

[VALL]

Díky, ale to je už nad moje znalosti. Data importuji pomocí Microsoft Query, která má funkci parametrického řízení dotazu (podmínka pro sql dotaz definovaná v sešitě). Netuším, jak funkcí řídit okamžik od změny buňky, která vyvolá spuštění dotazu.

--- Doplnění předchozího příspěvku (12 Čer 2012 16:08) ---

Odpověď Azuzule:
SQl Dotaz si šahá do sql databáze - nějaké tabulky. Takže funkcionalita je pevně daná a já nemám šanci to jakkoliv změnit.

[Azuzula]

Tak v tom případě nevím, SQL je na mě momentálně vyšší dívčí, ale jak psal D1amond. Tedy pokud jde MS Query také ovládat s VBA, tak by to už nějak vymyslet šlo.
Další věc co mě napadá (pokud se pro ten import otevře nějaké okno, tak by zavření toho okna šlo hlídat za pomoci API funkce FindWindow a tím případně oddálit proběhnutí druhého makra.

[VALL]

To zní zajímavě. Máte nějaký příklad (kód), podle kterého bych se mohl inspirovat?

[Azuzula]

Kód: Vybrat vše

Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
     ByVal lpClassName As String, _
     ByVal lpWindowName As String) As Long

sub hlidej_okno
Dim najdiokno
Dim program As String
program = "C:\WINDOWS\system32\cmd.exe" 'cesta k souboru, nebo celý název otevřeného okna.
najdiokno = FindWindow(vbNullString, program)
Do While Not najdiokno = 0
najdiokno = FindWindow(vbNullString, program)
Loop
end sub