VBA in SQL drugi del

Takole, od zadnjič sem celo vso stvar malce nadgradil in sedaj lahko z veseljem povem, da deluje iskanje kot se spodobi. Poleg tega, sem dodal kopiranje podatkov v nov excelov dokument, brisanje rezultatov,... Malce pa sem dodelal tudi sam obrazec za iskanje in sedaj izgleda tako:

Iskalno okno se avtomatsko zažene ob zagonu Excelove datoteke. To storimo z ukazom:


Private Sub Workbook_Open()
    UserForm1.Show
End Sub

Ukaz vnesemo tako, da v VBA-ju dvakrat kliknemo ThisWorkBook v VBAProject in potem iz padnih menijev izberemo: Workbook in Open.

Ostalo kodo vnesemo v obrazec. Izgleda pa tako:


Private Sub CmdIsci_Click()


'spuca vse podatke na listu
List1.Cells.Clear


    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "ODBC;DATABASE=zzzzz;DRIVER={MySQL ODBC 3.51 Driver};OPTION=0;;PORT=0;SERVER=xxx.xxx.x.xx;UID=XXX;PASSWORD=YYY" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandText = Array( _
                "SELECT inkasso_2010_om_odvpr_0.OM, inkasso_2010_om_odvpr_0.OM_NAZIV AS 'NAZIV', inkasso_2010_obcine_odvpr_0.OBCINA_NAZIV AS 'OBČINA', inkasso_2010_sif_kraj_sk_odvpr_0.KRAJ_SK_NAZIV AS 'NASELJE', inkas" _
        , _
        "so_2010_sif_ulic_odvpr_0.ULICA_NAZIV AS 'ULICA', CONCAT(inkasso_2010_om_odvpr_0.OM_HS,inkasso_2010_om_odvpr_0.OM_HSD) AS 'Hst', inkasso_2010_om_posode_odvpr_0.POSODE_ODPADEK AS 'FRAKCIJA', inkasso_201" _
        , _
        "0_posode_odvpr_0.POSODA_VOLUMEN AS 'VOL', inkasso_2010_om_posode_odvpr_0.POSODE_FREKVENCA AS 'FREK', inkasso_2010_om_posode_odvpr_0.POSODE_IDENTST AS 'INVENTARNA', inkasso_2010_om_pogodbe_odvpr_0.POGO" _
        , _
        "DBA_STEVILKA AS 'POGODBA'" & Chr(13) & "" & Chr(10) & "FROM sezana.inkasso_2010_obcine_odvpr inkasso_2010_obcine_odvpr_0, sezana.inkasso_2010_om_odvpr inkasso_2010_om_odvpr_0, sezana.inkasso_2010_om_pogodbe_odvpr inkasso_2010_om" _
        , _
        "_pogodbe_odvpr_0, sezana.inkasso_2010_om_posode_odvpr inkasso_2010_om_posode_odvpr_0, sezana.inkasso_2010_posode_odvpr inkasso_2010_posode_odvpr_0, sezana.inkasso_2010_sif_kraj_sk_odvpr inkasso_2010_s" _
        , _
        "if_kraj_sk_odvpr_0, sezana.inkasso_2010_sif_ulic_odvpr inkasso_2010_sif_ulic_odvpr_0" & Chr(13) & "" & Chr(10) & "WHERE inkasso_2010_om_odvpr_0.OM = inkasso_2010_om_posode_odvpr_0.OM AND inkasso_2010_om_odvpr_0.KRAJ_SK_SIFRA = i" _
        , _
        "nkasso_2010_sif_kraj_sk_odvpr_0.KRAJ_SK_SIFRA AND inkasso_2010_om_odvpr_0.ULICA_SIFRA = inkasso_2010_sif_ulic_odvpr_0.ULICA_SIFRA AND inkasso_2010_om_odvpr_0.OM = inkasso_2010_om_pogodbe_odvpr_0.OM AN" _
        , _
        "D inkasso_2010_om_odvpr_0.OBCINA_SIFRA = inkasso_2010_obcine_odvpr_0.OBCINA_SIFRA AND inkasso_2010_om_pogodbe_odvpr_0.POGODBA_STEVILKA = inkasso_2010_om_posode_odvpr_0.POGODBA_STEVILKA AND inkasso_201" _
        , _
        "0_om_posode_odvpr_0.POSODA_SIFRA = inkasso_2010_posode_odvpr_0.POSODA_SIFRA AND ((inkasso_2010_om_pogodbe_odvpr_0.POGODBA_AKTIVNA='T') AND (inkasso_2010_om_posode_odvpr_0.POSODE_ZARACUNLJIVOST=2) AND " _
        , "(inkasso_2010_om_odvpr_0.OM_AKTIVEN='T'))" _
        , _
        " AND inkasso_2010_om_odvpr_0.OM LIKE '%" & UserForm1.TxtOm.Text & "%' AND inkasso_2010_om_odvpr_0.OM_NAZIV LIKE '%" & UserForm1.TxtNaziv.Text & "%' AND inkasso_2010_obcine_odvpr_0.OBCINA_NAZIV LIKE '%" & UserForm1.TxtObcina.Text & "%'", _
        " AND inkasso_2010_sif_kraj_sk_odvpr_0.KRAJ_SK_NAZIV LIKE '%" & UserForm1.TxtNaselje.Text & "%' AND inkasso_2010_sif_ulic_odvpr_0.ULICA_NAZIV LIKE '%" & UserForm1.TxtUlica.Text & "%' AND inkasso_2010_om_odvpr_0.OM_HS LIKE '%" & UserForm1.TxtHisna.Text & "%'", _
        " AND inkasso_2010_om_odvpr_0.OM_HSD LIKE '%" & UserForm1.TxtDod.Text & "%' AND inkasso_2010_om_posode_odvpr_0.POSODE_ODPADEK LIKE '%" & UserForm1.TxtFrakcija.Text & "%' AND inkasso_2010_om_posode_odvpr_0.POSODE_IDENTST LIKE '%" & UserForm1.TxtInventarna.Text & "%' AND inkasso_2010_om_posode_odvpr_0.POGODBA_STEVILKA LIKE '%" & UserForm1.txtPogodba.Text & "%'" _
        )
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Tabela_izpis"
        .Refresh BackgroundQuery:=False
    End With
End Sub


Private Sub cmdKopiraj_Click()
        
    ActiveWorkbook.Sheets(1).Activate
    Range("A1:J1, Tabela_izpis").Select
    Selection.Copy
        
    Workbooks.Add
    ActiveWorkbook.Sheets(1).Activate
    ActiveSheet.Cells(1, 1).PasteSpecial
  
End Sub


Private Sub cmdNovo_Click()
    Workbooks("iskanje_sql.xlsm").Activate
End Sub


Private Sub CommandButton1_Click()
    List1.Cells.Clear

End Sub

VBA in SQL

Živimo, baje, v času recesije, zato je potrebno včasih kakšno stvar narediti po težji poti. Ena od takih, se mi je zgodila nekaj dni nazaj. Gre sicer za precej banalen primer, ki bi se ga dalo preprosto rešiti s pomočjo MS Accessa ali pa bi se preprosto programerjem plačalo, da naredijo poročilo v trenutne programu. No, ničesar od tega ni bilo, zato sem se držal reka: "pomagaj si sam in bog ti bo pomagal".

Opis problema

Program za vodenje katastrov temelji na bazi MySql, vendar nima pripravljenih določenih izpisov. Z uporabo Excela lahko sicer naredimo query, a se pri malo manj ukih uporabnikih zatakne pri nastavljanju parametrov izpisa. Navadno pride do tega, da kliknejo na bližnjico za zagon poizvedbe in potem pobrišejo vse nepotrebne vrstice (mogoče celo stolpce). Tukaj pa nam pride hitro v pomoč VBA.

Celotna skripta še ni dodelana, ampa za prvo silo deluje. Sestavljena je iz preprostega obrazca s tremi besedilnimi polji (TextBox) in dveh gumbov.

Nato pa seveda dodamo še malo besedila, ki bo naredilo nekaj pametnega.

Za gum "Išči" sledi naslednje:


Private Sub CommandButton1_Click()


'Spucamo vse podatke na delovnem listu
List1.Cells.Clear


'povezemo se z MySQL bazo
'ce dopisemo ;PASSWORD=xxxxxx;, ne rabimo vpisovat gesla po zagonu skripte
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "ODBC;DATABASE=komunala;DRIVER={MySQL ODBC 3.51 Driver};OPTION=0;;PORT=0;UID=danijel;" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandText = Array( _
        "SELECT bass_pogodbe_0.ID, bass_pogodbe_0.OBCINA_SIFRA, bass_pogodbe_0.OBCINA_NAZIV, bass_pogodbe_0.KRAJ_SK_SIFRA, bass_pogodbe_0.KRAJ_SK_NAZIV, bass_pogodbe_0.ULICA_SIFRA, bass_pogodbe_0.ULICA_NAZIV, " _
        , _
        "bass_pogodbe_0.OM_HS, bass_pogodbe_0.OM_HSD, bass_pogodbe_0.OM, bass_pogodbe_0.OM_NAZIV, bass_pogodbe_0.OM_PLACNIK, bass_pogodbe_0.NAZIV, bass_pogodbe_0.NASLOV, bass_pogodbe_0.PTT, bass_pogodbe_0.KRAJ" _
        , _
        ", bass_pogodbe_0.POGODBA_STEVILKA" & Chr(13) & "" & Chr(10) & "FROM komunala.bass_pogodbe bass_pogodbe_0" & Chr(13) & "" & Chr(10) & _


'pa se pogoji, ki se nanasajo na textboxe
        "WHERE (bass_pogodbe_0.ULICA_NAZIV LIKE '%" & UserForm1.txtUlica.Text & "%' AND bass_pogodbe_0.OBCINA_SIFRA LIKE '%" & UserForm1.txtObcina.Text & "%' AND bass_pogodbe_0.OM_NAZIV LIKE '%" & UserForm1.txtOmNaziv.Text & "%' )")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Tabela_Poizvedba_iz_mysql"
        .Refresh BackgroundQuery:=False
    End With


End Sub

Z drugim gumbom natisnemo vsebino lista:


Private Sub CommandButton2_Click()

     With ActiveSheet.PageSetup

        .PrintTitleRows = "$1:$1"

        .PrintTitleColumns = ""

    End With

Application.Dialogs(xlDialogPrint).Show

End Sub

To je nekako osnovno, kar je bilo narejeno. Po željah in zmožnostih, bomo pa dodajali tudi nove stvari.