< návrat zpět
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
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).
Zkus
citovat 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
RSS nejnovější články