• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Pozastavenie behu makra do doby aktualizácie Qry

Zaslal/a AL 28.5.2016 12:40

Ahoj, ako by šlo elegantne vyriešiť pozastavenie makra do doby, než prebehne aktualizácia QueryTable? V makre mám stopku, ale trochu mi vadí, že musím potom 8 x mačkať F5.
Application.Wait nepomohol, preto tá stopka. Prikladám pre ilustráciu kód, pokiaľ by ma niekto dokázal naviesť, budem vďačný, zverejniteľný súbor v túto chvíľu nemám, než by som to vytvoril z toho ostrého, zabijem s tým niekoľko hodín. Je to pomerne komplikovaný dashboard, ktorý som zdedil a ktorý si postupne pretváram a automatizujem k obrazu svojmu. Tu je teda aspoň ten kódik:Sub Update_CM_sheets()
Dim qt As QueryTable, forDel As Worksheet, Cat As String, sqlStr As String, conStr As String, myArr(), i As Byte
Dim xlTblName As String, srcRng As Range, tgtRng As Range

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
myArr = Array("Equipment", "IT", "Lab", "Logis", "Real Estate", "Subcon", "Travel", "Other")
conStr = "ODBC;DSN=Excel Files;DBQ=" & ThisWorkbook.FullName & ";DriverId=1046;MaxBufferSize=2048;PageTimeout=5;"

For i = LBound(myArr) To UBound(myArr)
Select Case i
Case 4: xlTblName = "xlTbl_RealEstate"
Case Else: xlTblName = "xlTbl_" & myArr(i)
End Select
Cat = myArr(i)
Set forDel = Sheets.Add

'**********************************************************************************************************************
sqlStr = "SELECT [Region Level 3] AS Country, [Project Title] AS [PROJECT NAME], Status AS [Progress Status], " & _
"'' AS [COMMENTS / ACTION ITEMS], [SPEND IN CHF], [ANNUAL SAVINGS CHF (NOT DEPREC)], " & _
"[Annual Savings CHF (Deprec)] AS [SAVING TARGET], [REGIONS], [PROJECT OWNER], " & _
"[Project Number] AS [PROJECT ID], [Category Level 1] AS [SGS COMMODITY], " & _
"[Region Level 2] AS [REGION], [Status] AS [PROJECT STATUS], " & _
"[Execution Start Date] AS [PLANNED START DATE], " & _
"[Execution End Date] AS [PLANNED END DATE], [REALIZATION START MONTH], " & _
"[Project Strategy], [Phase], [Estimated Spend] AS [BASELINE SPEND CHF], " & _
"[CAPEX Depreciation (in years)] AS [CAPEX DEPRECIATION (YEARS)],[Savings Type], [Capex] " & _
"FROM Pipeline WHERE CM='" & Cat & "'"

conStr = "ODBC;DSN=Excel Files;DBQ=" & ThisWorkbook.FullName & ";DriverId=1046;MaxBufferSize=2048;PageTimeout=5;"

forDel.QueryTables.Add(Connection:=conStr, Destination:=Range("A1"), Sql:=sqlStr).Refresh

' Application.Wait (Now + TimeValue("0:00:30"))
Stop

Set srcRng = forDel.[A1].CurrentRegion
Set srcRng = srcRng.Offset(1, 0).Resize(srcRng.Rows.Count - 1, 4)
Set tgtRng = Range(xlTblName).Cells(1, 1)

srcRng.Copy
tgtRng.PasteSpecial xlPasteValues
Application.CutCopyMode = False


Set srcRng = forDel.[A1].CurrentRegion
Set srcRng = srcRng.Offset(1, 4).Resize(srcRng.Rows.Count - 1, srcRng.Columns.Count - 4)
Set tgtRng = Range(xlTblName).Cells(1, 6)

srcRng.Copy
tgtRng.PasteSpecial xlPasteValues
Application.CutCopyMode = False

Application.DisplayAlerts = False
forDel.Delete
Application.DisplayAlerts = True

Next i

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox ("Done")
End Sub

Zaslat odpověď >

---

eLCHa(28.5.2016 13:54)#031638

Mno
Já používám něco takového With .QueryTables.Add(Connection:=sSource, Destination:=.Range("Data"), SQL:=sSQL)
.AdjustColumnWidth = False
.FieldNames = False
.Refresh BackgroundQuery:=False
.Delete
End With '.QueryTables.Add(Connection:=sSource, Destination:=Range("Data"), Sql:=sSQL)a čeká to na načtení (BackgroundQuery = False).
Zkuscitovat

AL(28.5.2016 14:53)#031639

Tak to je vtipné. Už som to chcel po prebdenej noci vypnúť s tým, že sa na ten Tvoj nápad pozriem až v pondelok v práci. Ale potom mi to nedalo, páč to nevypadalo nijako zložito. A skutočne, stačilo za moju inštrukciu forDel.QueryTables.Add(Connection:=conStr, Destination:=Range("A1"), Sql:=sqlStr).Refresh dopísať ten parameter, takže forDel.QueryTables.Add(Connection:=conStr, Destination:=Range("A1"), Sql:=sqlStr).Refresh BackgroundQuery:=FalseNjn, to je tak, keď zabúdam na on-line nápovedu. Ešte, že si tu Ty, Lubo, Petr Pecháček a ešte pár ďalších bystrých ľudí. Ja som si hovoril, že to časom nejak prepíšem, ale Tvoja rada bola geniálne jednoduchá, takže Ti za ňu veľmi pekne ďakujem. Ja som vedel, že treba znemožniť aktualizáciu na pozadí, akurát som nedokázal prísť na to, kam to zapísať. Máš u mňa pivo, ale do Ostravy asi cestu mať nebudem, tak sa musíš, Karle, zastaviť Ty :) Ďakujem krásne.citovat

eLCHa(30.5.2016 8:13)#031642

;)
Do Prahy jezdím tak 2x za 10 let, takže se "brzy ozvu" a vyzvednu si to ;))citovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse