Evo ti kood koji to radi u jednoj od mojih aplikacija. Pokreni ga na On Click nekog dugmeta. Možeš da napraviš traku za napredovanje, a ako nećeš isključi deo koda koji se odnosi na objekat TEMPO. Koristim DAO 3.6 za VBA.
Code:
Private Sub OK_Click()
' kod za izbor klijenta
Dim Baza As Database
Dim tabela As TableDef
Dim Tek_Tab As Long ' tekuca tabela
Dim Ukp_Tab As Long ' ukupno tabela
Dim i As Long
Dim Sl_Priv As Recordset
' DoCmd.Hourglass True
' Me![SPISAK].SetFocus
Me![TEMPO].SetFocus 'traka dobija fokus
Me![OK].Enabled = False 'dugme postaje nedostupno
Tek_Tab = 0
Ukp_Tab = CurrentDb().TableDefs.Count
For Each tabela In CurrentDb().TableDefs ' linkovanje na izabrane tabele
Tek_Tab = Tek_Tab + 1 ' brojac tekucih tabela
' Me![OK].Caption = CLng(Tek_Tab / Ukp_Tab * 100) & " %" ' CLNG - Konvertovanje u Long integer
' For i = 1 To 5
' DoEvents ' dozvoljava Windowsu da radi nesto ako ima tako se malo usporava petlja
' Next
Me![TEMPO].Value = Tek_Tab / Ukp_Tab * 100 ' AktiveX Kontrola
If Len(tabela.Connect) > 0 Then
tabela.Connect = ";DATABASE=" & Me![SPISAK]
tabela.RefreshLink
End If
Next
CurrentDb().Properties!AppTitle = "VODJENJE POGONSKOG KNJIGOVODSTVA - klijent " & DLookup("[SIFRAKOR]", "AS_KLIJENTI", "[PUTANJA]='" & Me![SPISAK] & "'") & " - " & DLookup("[FIRMA]", "AS_KLIJENTI", "[PUTANJA]='" & Me![SPISAK] & "'")
Me.Application.RefreshTitleBar ' upisivanje u Title Baru naziva izabranog klijenta
' taj naziv stoji do promene klijenta odnosno do novog
' linkovanja ,cak i posle gasenja i ponovnog paljenja racunara.
var_sifrakor = DLookup("[SIFRAKOR]", "AS_KLIJENTI", "[PUTANJA]='" & Me![SPISAK] & "'")
var_nazivkor = DLookup("[FIRMA]", "AS_KLIJENTI", "[PUTANJA]='" & Me![SPISAK] & "'")
var_ziroracun = DLookup("[ZIRORACUN]", "AS_KLIJENTI", "[PUTANJA]='" & Me![SPISAK] & "'")
var_adrfirme = DLookup("[ADRFIRME]", "AS_KLIJENTI", "[PUTANJA]='" & Me![SPISAK] & "'")
var_mesto = DLookup("[MESTO]", "AS_KLIJENTI", "[PUTANJA]='" & Me![SPISAK] & "'")
'var_banka = DLookup("[BANKA]", "AS_KLIJENTI", "[PUTANJA]='" & Me![SPISAK] & "'")
'var_racunbanke = DLookup("[RACUNBANKE]", "AS_KLIJENTI", "[PUTANJA]='" & Me![SPISAK] & "'")
' DoCmd.Hourglass False
DoCmd.OpenForm "Izborni meni", acNormal
' MsgBox "Klijent je odabran", vbInformation, "Obavestenje"
DoCmd.Close acForm, Name ' zatvara tekucu formu (Izbor klijenta)
' DoCmd.Close acForm, "Izborni meni"
' SendKeys "%u" 'sa Alt+u prelazi na osnovni meni (Procenat = ALT)
' SendKeys "%{F4}" ; funkcijski tasteri se stavljaju u velike zagrade
End Sub
Potpis