Seznam témat:
definice a rozvržení dokumentu
Příkladová studie: Sledování výkonů a plánů za divizi
Požadavek je na sestavu sledování aktuálních obratů účtů a jejich porovnání s plánem zadaným ve Vision ERP (menu Vision ERP | Účetnictví | Plán - rozpočet).
Protože potřebujeme zobrazit hodnoty jak z aktuálních stavů za danou divizi (cl1), tak i z definice plánovaného rozpočtu, budeme navzájem spojovat hodnoty N:N dle následujícího dotazu:
pro ISQL:
SELECT x.obd, x.konto,
(SELECT nazevr FROM dba.urozvrh WHERE urozvrh.konto=x.konto AND urozvrh.obd=x.obd) as nazevuctu,
x.mesic, LEFT(x.cl1,2) as divize, x.data_id, SUM(x.obratskut) as obratskut, SUM(x.obratplan) as obratplan,
(obratplan-obratskut) as rozdilkc
FROM (
SELECT ui.obd, ui.konto, ui.mesic, isnull(st.cl1,'empty') as cl1,
(SUM(st.dal) - SUM(st.md) ) as obratskut, 0 as obratplan, ui.data_id
FROM dba.udokst as st, dba.udokit as ui
WHERE ui.data_id = st.data_id AND ui.id_den = st.den
AND (SELECT druh FROM dba.uosn WHERE id_ukod=(SELECT ukod FROM dba.ukonta WHERE id_konto=ui.konto)) in (3,4)
GROUP BY ui.obd, ui.konto, ui.mesic, cl1, ui.data_id
UNION ALL
SELECT uplan.obd, uplan.konto, uplan.mesic, isnull(uplan.cl1,'empty') as cl1,
0 as obratskut, (SUM(uplan.dal) - SUM(uplan.md)) as obratplan, uplan.data_id
FROM dba.uplan
GROUP BY uplan.obd, uplan.konto, uplan.mesic, cl1, uplan.data_id
) as x
WHERE x.obd = '2002-01-01' AND x.mesic= '12'
GROUP BY x.obd, x.konto, x.mesic, divize, x.data_id
HAVING (obratskut <> 0 OR obratplan <>0)
ORDER BY x.obd, x.konto, x.mesic, divize, x.data_id
Kde samozřejmě hodnoty x.obd a x.mesic v klauzuli WHERE chceme zadávat ručně přes Excel (zde pouze pro test.účely).
UNION je použitý, aby se zobrazili i navzajem nekonzistentní zápisy, obsažené pouze v deníku nebo pouze v plánu.
HAVING odstraňuje stornované záznamy, které mají v konečném efektu nulový obrat a způsobují chybu při dělení nulou.
Definice a rozvržení dokumentu
Dokument bude mít tři listy
1) "Zadání" - zde se vkládají hodnoty
2) "DATA" - sem se načítají data
3) "Tabulka" - kontingenční tabulka, která zpracovává data z listu "DATA" do požadované formy.
Názvy listů můžete samozřejmě měnit, ale je pak potřeba změnit odkazy na ně ve všech makrech.
První tlačítko načítá data do záložky "DATA", druhé zaktualizuje kontingenční tabulku (dále jen KT). Přímo v KT nelze měnit načtené hodnoty, ale stačí je upravit požadovaným způsobem v záložce DATA a pak znovu aktualizovat KT.
| • | Přiražení maker tlačítkům : pravým tlačítkem myši kliněte na buttonek a zvolte "Přiřadit makro" |
a zvolte požadované makro.
V dokumentu je použito tří maker.
Postup :
"Spust"
spustí po kliknutí na tlačítko další makro, které provede vlastní načtení dat z databáze
Sub spust()
dotaz
End Sub
"AktualizovatKT_AROMA
Pro aktualizování kontingenční tabulky. (toto by se dalo teoreticky spojit přímo do jednoho, ale pak nebudeme mít možnost ručně měnit a upravovat načtená data).
Sub AktualizovatKT_AROMA()
Sheets("Tabulka").Select
Range("A5").Select
ActiveSheet.PivotTables("KT Aroma").RefreshTable
End Sub
- zde se volá list "Tabulka" - v případě přejmenování názvů listu, se musí upravit i zde.
- volá se také kontingenční tabulka s názvem "KT Aroma", platí totéž co výše
"Dotaz"
Hlavní a nejdůležitější makro :
Public Sub dotaz()
Dim ODBCwsp As Workspace ' Workspace se DAO objekt ktery pojmenovava session a urcuje nektere jeji vlastnosti
Dim ODBCcon As Connection ' toto je DAO connection - vlastni pripojeni do databaze
Dim ODBCrec As Recordset ' zde bude vysledek DB dotazu
Dim DBField As Field ' pole z vysledku
Dim radek As Long, sloupec As Long ' cislo radku a sloupce
Dim Sht As Object ' Sheet list sesitu excel
Set Sht = ActiveWorkbook.Worksheets("Zadání") ' List s nazvem "zadání"
Dim datum_od As Variant, datum_do As Variant
obdobi = Sht.Cells(4, 2).Value
mesic = Sht.Cells(5, 2).Value
Set Sht = ActiveWorkbook.Worksheets("DATA") ' List s nazvem DATA
Sht.Cells.Clear ' Vymazat stavajici obsah
Dim where_condition As String
where_condition = " " _
+ "x.obd='" + CStr(obdobi) + "' " _
+ " AND " _
+ "x.mesic='" + CStr(mesic) + "' "
Dim sql_string As String 'pozor ! na konci kazdyho (..plan " _) radku z definice je potreba nechat mezeru
sql_string = _
"SELECT " _
+ "x.obd, x.konto," _
+ " (SELECT nazevr FROM dba.urozvrh WHERE urozvrh.konto=x.konto AND urozvrh.obd=x.obd) as nazevuctu, " _
+ "x.mesic, LEFT(x.cl1,2) as divize, x.data_id, SUM(x.obratskut) as obratskut, SUM(x.obratplan) as obratplan, " _
+ "(obratplan-obratskut) as rozdilkc " _
+ "FROM ( " _
+ " SELECT ui.obd, ui.konto, ui.mesic, isnull(st.cl1,'empty') as cl1, " _
+ " (SUM(st.dal) - SUM(st.md) ) as obratskut, 0 as obratplan, ui.data_id " _
+ " FROM dba.udokst as st, dba.udokit as ui " _
+ " WHERE ui.data_id = st.data_id AND ui.id_den = st.den" _
+ " AND (SELECT druh FROM dba.uosn WHERE id_ukod=(SELECT ukod FROM dba.ukonta WHERE id_konto=ui.konto)) in (3,4) " _
+ " GROUP BY ui.obd, ui.konto, ui.mesic, cl1, ui.data_id " _
+ " UNION ALL " _
+ " SELECT uplan.obd, uplan.konto, uplan.mesic, isnull(uplan.cl1,'empty') as cl1, " _
+ " 0 as obratskut, (SUM(uplan.dal) - SUM(uplan.md)) as obratplan, uplan.data_id " _
+ " FROM dba.uplan " _
+ " GROUP BY uplan.obd, uplan.konto, uplan.mesic, cl1, uplan.data_id " _
+ " ) as x " _
+ " WHERE " _
+ where_condition _
+ "GROUP BY x.obd, x.konto, x.mesic, divize, x.data_id " _
+ "HAVING (obratskut <> 0 OR obratplan<>0) " _
+ "ORDER BY x.obd, x.konto, x.mesic, divize, x.data_id "
Set ODBCwsp = CreateWorkspace("", "dba", "", dbUseODBC) ' tady o nic jeste nejde
Set ODBCcon = ODBCwsp.OpenConnection("AROMA", , , "ODBC;DATABASE=AROMA;UID=dba;PWD=heslo;DSN=AROMA") ' pripojeni k DB
' - odbc a dsn musí být vyplněné, pokud nebude user a pwd, šáhne si buď
' do ODBC jestli je tam a nebo zobrazi přihlašovací okno na SQL
Set ODBCrec = ODBCcon.OpenRecordset(sql_string)
radek = 0
Do While Not ODBCrec.EOF ' pro vsechny radky - EOF nabude True pokud jiz nebude zadny dalsi radek vysledku
'MsgBox ODBCrec!nazev ' toto je jen pro ukazku - kdyby jsi znal nazvy sloupcu a chtel s tim neco delat
radek = radek + 1 ' pocitadlo radku si zvetsim o 1
If radek = 1 Then ' na prvnim radku bych chtel nazvy sloupcu
sloupec = 0
For Each DBField In ODBCrec.Fields ' pro vsechny sloupce z vysledku
sloupec = sloupec + 1
Sht.Cells(radek, sloupec) = DBField.Name ' zapis jejich nazev do bunky listu
Next
radek = radek + 1 ' na dalsich radcich budou data
End If
sloupec = 0
For Each DBField In ODBCrec.Fields ' pro vsechna pole vysledku
sloupec = sloupec + 1
Sht.Cells(radek, sloupec) = (DBField.Value) ' zapis jejich hodnotu (data) do bunky listu
Next
ODBCrec.MoveNext ' jdi na dalsi radek v recordsetu - nacti dalsi radek z DB
Loop
ODBCrec.Close ' uzavri dotaz
ODBCcon.Close ' odpoj se od DB
ODBCwsp.Close ' ukonci session
End Sub
Pozor ještě jednou na ty mezery na konci řádků v dotazu, kvůli zobrazení je dotaz sql rozdělen na více řádků, ale VB to spojuje pouze jako string, který se vyhodnocuje jinde, takže bez mezer bude jeden řádek plynule navazovat na slovo na dalším a dotaz bude tím pádem nefunkční.
HESLO : předpokládám u vývojářů jistou inteligenci, přesto upozorňuji, že je snad jasné, že DBA a heslo se nedostane k uživatelům ! Ať si to vyplní v ODBC a nebo se přihlašují se zadáním hesla a usera.
Závěr : takhle vytvořený dokument skvěle funguje, spojení je dostatečně rychlé, práci s excelem zvládají většinou i uživatelé, kteří primárně nepracují s Vision ERP.
Související témata