(12/01/2020, 11:42)berduş yazdı: kodları aşağıdaki gibi düzenler misiniz
txtAdAra değiştiğinde olayı
Private Sub txtAdAra_Change()
Ara (txtAdAra.Text)
End Sub
txtSoyadAra değiştiğinde olayı
Private Sub txtSoyadAra_Change()
Ara , txtSoyadAra.Text
End Sub
Ara fonksiyonu
Sub Ara(Optional adtxt As String, Optional soyadtxt As String) 'değişti
If IsNull(adtxt) Then adtxt = Me.txtAdAra.Value '<--Eklendi
If IsNull(soyadtxt) Then soyadtxt = Me.txtSoyadAra.Value'<--Eklendi
With cn
If .State = adStateOpen Then
.Close
Set cn = Nothing
End If
End With
Set cn = CurrentProject.Connection
strSQL = "Select id,FORMAT(Tarih, 'dd.mm.yyyy') as Tarih,Ad,Soyad,Yas,format(Telefon,'(###) ### ## ##')as Telefon From Tablo1 where Not IsNull(id)"
' If Not IsNull(Me.txtAdAra.Value) Then strSQL = strSQL & " and Ad like '%" & Me.txtAdAra.Value & "%'" '<--silindi
' If Not IsNull(Me.txtSoyadAra.Value) Then strSQL = strSQL & " and Soyad like '%" & Me.txtSoyadAra.Value & "%'" '<--silindi
strSQL = strSQL & " and Ad like '%" & adtxt & "%'" & " and Soyad like '%" & soyadtxt & "%'" 'silindi diğerleri sadece bu eklendi
With rs
If .State = adStateOpen Then .Close
.CursorType = adOpenDynamic
.CursorLocation = 3
.LockType = adLockOptimistic
.Open strSQL, cn, , , 1
End With
Lstbox.ColumnCount = 6
Lstbox.ColumnWidths = "2Cm;2Cm;3Cm;3Cm;3Cm;3Cm"
Lstbox.ColumnHeads = True
Set Lstbox.Recordset = rs
End Sub
Teşekkürler sayın @
berduş.
Kod yapıları değişmiş sanırım 10 adet Textbox ile bağlantılı arama yapılsa kodlar uzayacak.
Excel ile arşivim vardı orda kod yapıları aynı ve hata olmuyor.
Acaba benim eklediğim
Access dosyasında neden hataoluyor?
Excel dosyasını ve kodlarını ekleyeyim bir deneyiniz.O kodlara göre
Access kodları ayarlanmalı.Çünkü başka planlarım var
Private Sub TextBox1_Change()
Call Me.listele
End Sub
Private Sub TextBox2_Change()
Call Me.listele
End Sub
Private Sub TextBox3_Change()
Call Me.listele
End Sub
Private Sub TextBox4_Change()
Call Me.listele
End Sub
Private Sub TextBox5_Change()
Call Me.listele
End Sub
Private Sub TextBox6_Change()
Call Me.listele
End Sub
Sub listele()
Dim s As String
Me.ListBox1.Clear
DoEvents
Dim con As Object
Application.ScreenUpdating = False
Set con = CreateObject("adodb.connection")
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;"""
With Me
s = "select f1,f2,f3,f4,Format(f5,'dd.mm.yyyy'),f6 from [Sayfa1$A2:F65000] where not isnull(f1)" 'Tarih formati
If .TextBox1.Text <> "" Then s = s & " and f1 like '" & .TextBox1.Text & "'" 'ilk harflere göre arama yapar % textbox icin & combobox icin * yerine gecer
If .TextBox2.Text <> "" Then s = s & " and f2 like '" & .TextBox2.Text & "'" 'ilk harflere göre arama yapar % textbox icin & combobox icin * yerine gecer
If .TextBox3.Text <> "" Then s = s & " and f3 like '" & .TextBox3.Text & "'" 'ilk harflere göre arama yapar % textbox icin & combobox icin * yerine gecer
If .TextBox4.Text <> "" Then s = s & " and f4 like '" & .TextBox4.Text & "'" 'ilk harflere göre arama yapar % textbox icin & combobox icin * yerine gecer
If .TextBox5.Text <> "" Then s = s & " and Format(f5,'dd.mm.yyyy') like '" & .TextBox5.Text & "'" 'Tarih formati
If .TextBox6.Text <> "" Then s = s & " and f6 like '" & .TextBox6.Text & "'" 'ilk harflere göre arama yapar % textbox icin & combobox icin * yerine gecer
On Error Resume Next
.ListBox1.ColumnCount = 120
.ListBox1.Column = con.Execute(s).getrows
End With
Application.ScreenUpdating = True
Set con = Nothing
End Sub
ADO ile Textbox ve Listbox.rar
(Dosya Boyutu: 23,5 KB | İndirme Sayısı: 0)