- Katılım
- 12 Ocak 2009
- Mesajlar
- 838
- Excel Vers. ve Dili
- 2003
- Altın Üyelik Bitiş Tarihi
- 07-02-2024
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Private Sub txtSorgu_Change()
Set baglan = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
On Error GoTo SafeExit:
Call BAGLANTI
[AA1] = txtSorgu
If OptionButton1.Value = True Then
rs.Open "select * from [REHBER] WHERE [REHBER].ADI_SOYADI LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1
ElseIf OptionButton2.Value = True Then
rs.Open "select * from [REHBER] WHERE [REHBER].TC_KIMLIK LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1
ElseIf OptionButton3.Value = True Then
rs.Open "select * from [REHBER] WHERE [REHBER].IL LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1
ElseIf OptionButton4.Value = True Then
rs.Open "select * from [REHBER] WHERE [REHBER].ILCE LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1
ElseIf OptionButton5.Value = True Then
rs.Open "select * from [REHBER] WHERE [REHBER].SICIL LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1
'.....
'...
'..
End If
txKimlik = rs(0)
txtAdi = rs(1) 'Adı Soyadı
txtTCKimlik = rs(2) 'kimliği
cmbIL = rs(3) 'il
cmbILCE = rs(4) 'ilçe
'.....
'...
'..
SafeExit:
If Err.Number = 3265 Then
MsgBox "Sorgulama için bir seçenek işaretleyin...!"
Exit Sub
End If
rs.Close
Set rs = Nothing
Set baglan = Nothing
End Sub
Teşekkür ederim Haluk hocam.Aşağıdaki gibi bir kod kullanılabilir....
"String" tipindeki verileri MDB'den sorgularken, büyük harfe çevirmek için TextBox'dan AA1 hücresine aktarıp, Excel'in yerleşik UPPER fonksiyonuyla büyük harfe çeviriyoruz çünkü; VBA Türkçe karakterleri büyük harfe çevirirken bazılarında başarısızdır. ("İ" harfi gibi....)
Ben 4-5 tanesini hazırladım, diğerlerini de siz benzer şekilde yaparsınız.
.Kod:Private Sub txtSorgu_Change() For i = 1 To 21 If Me.Controls("OptionButton" & i) = False Then x = x + 1 End If Next If x = 21 Then MsgBox "Sorgulama için bir seçenek işaretleyin...." Exit Sub End If Set baglan = CreateObject("adodb.connection") Set rs = CreateObject("adodb.recordset") On Error GoTo SafeExit: Call BAGLANTI [AA1] = txtSorgu If OptionButton1.Value = True Then rs.Open "select * from [REHBER] WHERE [REHBER].ADI_SOYADI LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1 ElseIf OptionButton2.Value = True Then rs.Open "select * from [REHBER] WHERE [REHBER].TC_KIMLIK LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1 ElseIf OptionButton3.Value = True Then rs.Open "select * from [REHBER] WHERE [REHBER].IL LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1 ElseIf OptionButton4.Value = True Then rs.Open "select * from [REHBER] WHERE [REHBER].ILCE LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1 ElseIf OptionButton5.Value = True Then rs.Open "select * from [REHBER] WHERE [REHBER].SICIL LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1 '..... '... '.. End If txKimlik = rs(0) txtAdi = rs(1) 'Adı Soyadı txtTCKimlik = rs(2) 'kimliği cmbIL = rs(3) 'il cmbILCE = rs(4) 'ilçe '..... '... '.. SafeExit: If Err Then MsgBox "Aranan veri bulunamadı...!" rs.Close Set rs = Nothing Set baglan = Nothing End Sub
Set baglan = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Call baglanti
rs.Open "select * from [REHBER] WHERE [REHBER].ADI_SOYADI LIKE '%" & txtAdi.Text & "%'", baglan, 1, 1
With ListBox1
.RowSource = Empty
.ColumnCount = 24
.ColumnWidths = "30;30"
.Column = rs.getrows
End With
rs.Close
Set rs = Nothing
Tekrar teşekkür ederim hocam.2. mesajdaki kodu revize etmiştim ..... Tekrar dener misiniz?
.
Haluk hocam ilginiz ve emeğiniz için teşekkür ederim.Üzgünüm...
Sizde bununla ilgili bir kod vardı ve çalışır hale getirmiştik. Onunla biraz uğraşın bence...
.
Private Sub txtSorgu_Change()
If OptionButton1.Value = True Then
ListView1.ListItems.Clear
Set baglan = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Call BAGLANTI
rs.Open "select * from [REHBER] WHERE [REHBER].ADI_SOYADI LIKE '%" & txtSorgu & "%'", baglan, 1, 1
sorgu
End If
If OptionButton2.Value = True Then
ListView1.ListItems.Clear
Set baglan = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Call BAGLANTI
rs.Open "select * from [REHBER] WHERE [REHBER].TC_KIMLIK LIKE '%" & txtSorgu & "%'", baglan, 1, 1
sorgu
End If
....
End Sub
Private Sub sorgu()
ListView1.ListItems.Clear
Dim satir As Integer
On Error Resume Next
If Not rs.EOF Then
Do While Not rs.EOF
Set evn = ListView1.ListItems.Add(, , rs.Fields("KIMLIK"))
evn.SubItems(1) = rs.Fields("ADI_SOYADI")
evn.SubItems(2) = rs.Fields("TC_KIMLIK")
evn.SubItems(3) = rs.Fields("IL")
evn.SubItems(4) = rs.Fields("ILCE")
evn.SubItems(5) = rs.Fields("SICIL")
evn.SubItems(6) = rs.Fields("UNVAN")
evn.SubItems(7) = rs.Fields("GOREV")
evn.SubItems(8) = rs.Fields("FIRMA")
evn.SubItems(9) = rs.Fields("KURUM")
evn.SubItems(10) = rs.Fields("BASKANLIK")
evn.SubItems(11) = rs.Fields("BIRIM")
evn.SubItems(12) = rs.Fields("KAT")
evn.SubItems(13) = rs.Fields("ODA_NO")
evn.SubItems(14) = rs.Fields("IS_TEL")
evn.SubItems(15) = rs.Fields("FAKS")
evn.SubItems(16) = rs.Fields("DAHILI")
evn.SubItems(17) = rs.Fields("CEP")
evn.SubItems(18) = rs.Fields("E_POSTA")
evn.SubItems(19) = rs.Fields("ADRES")
evn.SubItems(20) = rs.Fields("VERGI_N")
evn.SubItems(21) = rs.Fields("VERGI_D")
evn.SubItems(22) = rs.Fields("NOT")
rs.MoveNext
Loop
End If
rs.Close: con.Close
Set rs = Nothing
End Sub