1 - referanslara microsof Activex Data Object xx eklendi
2 - form active ederken liste kutusunu doldurma kodu hatalı çalıştığı için devre dışı bırakıldı
3 - butona aşağıdaki kod eklendi
If Len(Me.ComboBox1 & "") < 1 Or Len(Me.ComboBox2 & "") < 1 Then Exit Sub
Dim BasTrh As Long
Dim BitTrh As Long
BasTrh = DateSerial(Me.ComboBox1, (Me.ComboBox2.ListIndex Mod 12), 15)
BitTrh = DateSerial(Me.ComboBox1, Me.ComboBox2.ListIndex + 1, 14)
Dim Sql As String
Dim ADO_RS As ADODB.Recordset
Dim ADO_CN As ADODB.Connection
SQL = "SELECT " & _
"[Personel$B2:N].[F1], " & _
"[Personel$B2:N].[F2], " & _
"[Personel$B2:N].[F3], " & _
"[Personel$B2:N].[F6], " & _
"[Personel$B2:N].[F7], " & _
"[Personel$B2:N].[F8], " & _
"[Personel$B2:N].[F9], " & _
"[Personel$B2:N].[F10], " & _
"Cdate(DateAdd(""yyyy"",1,[Personel$B2:N].[F13])), " & _
"[ÖğrenimDurumu$A3:E].[F4], " & _
"[ÖğrenimDurumu$A3:E].[F5] " & _
"FROM [Personel$B2:N] INNER JOIN [ÖğrenimDurumu$A3:E] ON ([Personel$B2:N].[F12] = [ÖğrenimDurumu$A3:E].[F3]) " & _
"AND ([Personel$B2:N].[F11] = [ÖğrenimDurumu$A3:E].[F2]) AND ([Personel$B2:N].[F10] = [ÖğrenimDurumu$A3:E].[F1]) " & _
"WHERE ((([Personel$B2:N].[F13])>=" & BasTrh & " And ([Personel$B2:N].[F13])<=" & BitTrh & "));"
Set ADO_RS = New ADODB.Recordset
Set ADO_CN = New ADODB.Connection
ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & _
";extended properties=""excel 8.0;hdr=No"""
ADO_CN.Open
ADO_RS.Open SQL, ADO_CN, 3, 1
'
' Eğer Hiç Kayıt Yoksa
If ADO_RS.RecordCount = 0 Then
MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"
ListBox1.Clear
GoTo son
End If
ADO_RS.MoveLast
ADO_RS.MoveFirst
ListBox1.ColumnCount = 11
ListBox1.Column = ADO_RS.GetRows
son:
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = NothingNot: liste kutusuna başlıklar eklenmedi verileri iyice kontrol edin sonuç doğruysa başlıklar 2. bir liste kutusu olarak eklenebilir
