Prikazi cijelu temu 07.01.2014 19:20
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Lokacija:Tuzla


Predmet:Univerzalna pretraga
evo jedan kod za univerzalnu pretragu.
Treba izmijeniti imena polja iz tabele i imena polja na formi iz kojih se uzima kriterij pretrage.
Jos treba upisati i ime tabele iz koje se vrsi pretraga kao i putanja do recordsource ako ce na radi na istoj formi.
PreuzmiIzvorni kôd (Visual Basic):
  1. Private Sub DodajUslov(Vrijednost, ImePolja As String, Kriterija As String, Brojac As Integer)
  2.  
  3.  If IsNumeric(Vrijednost) = False Then
  4.  Vrijednost = Vrijednost & Chr(42)
  5.  End If
  6.  
  7.  If IsDate(Vrijednost) Then
  8.  Vrijednost = "#" & Vrijednost & "#"
  9.  End If
  10.  
  11.  If Vrijednost <> "" Then
  12.      If Brojac > 0 Then
  13.          Kriterija = Kriterija & " and "
  14.      End If
  15.  
  16.          Kriterija = (Kriterija & ImePolja & " Like " & Chr(39) & Vrijednost & Chr(39))
  17.          Brojac = Brojac + 1
  18.  End If
  19.  
  20.  End Sub
  21.  
  22.  Private Sub TaterZaPretragu_Click()
  23.  Dim MySQL As String, Kriterija As String, RekordSours As String
  24.      Dim ImepoljaT As String, ImePolja As String, ImeTabele As String
  25.      Dim Brojac As Integer, I As Integer
  26.  
  27.  
  28.      
  29.      
  30.      ImeTabele = "ImeTabele iz koje vrsimo pretragu" '
  31.     MySQL = "SELECT * FROM " & ImeTabele & " WHERE "
  32.      
  33.      For I = 1 To 6 ' 6 je broj polja
  34.     'Ovo su imena polja u tabeli iz koje vrsimo pretragu
  35.     ImepoljaT = Choose(I, "ImePolja1", "ImePolja2", "ImePolja3", "Imepolja4")
  36.      'Ovo su imena polja na formi u koja upisujemo kriterije pretrage
  37.     ImePolja = Choose(I, "ImePolja1", "ImePolja2", "ImePolja3", "Imepolja4")
  38.      DodajUslov Me(ImePolja), ImepoljaT, Kriterija, Brojac
  39.      Next I
  40.      
  41.      If Kriterija = "" Then
  42.          Kriterija = "True"
  43.      End If
  44.  
  45.      RekordSours = MySQL & Kriterija
  46.      Me.RecordSource = RekordSours
  47.      
  48.      If Me.RecordsetClone.RecordCount = 0 Then
  49.          MsgBox "Nema podataka po ovom kriteriju"
  50.      End If
  51.  End Sub
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.