2 ekleme var
1 - yeni bir sayfa eklendi
2 - Activex Data Object eklendi
form başlatılırken olayı
Option Compare Text
Const Ekleme As String = "'ŞABLON','Sayfa1','liste','TmpSilme'"
Dim Sql As String
Dim Cn As Object
Dim Rs As Object
Dim RsSchema As Object
Private Sub ComboBox1_Change()
Me.ComboBox1.DropDown
Dim syf As Worksheet, k As Byte
If Len(Me.ComboBox1.Value & "") = 0 Then
Sql = "select [F1] from [TmpSilme$A:A] where not isnull(f1)"
Else
Sql = "select [F1] from [TmpSilme$A:A] where not isnull(f1) and [f1] like '%" & Me.ComboBox1.Text & "%' order by [F1]"
End If
Set Cn = CreateObject("Adodb.Connection")
Set Rs = CreateObject("adodb.recordset")
Cn.Open "provider=Microsoft.ACE.OLEDB.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=no"""
Rs.Open SQL, Cn, 1, 1 '
' Eğer Hiç Kayıt Yoksa
If Rs.RecordCount = 0 Then
Rs.Close
Cn.Close
Set Rs = Nothing
Set Cn = Nothing
MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"
Exit Sub
End If
ComboBox1.Column = Rs.GetRows
Rs.Close
Rs.Open SQL, Cn, 1, 1
With Me.ListBox1
.ColumnCount = Rs.Fields.Count
.Column = Rs.GetRows
End With
Rs.Close
Cn.Close
Set Rs = Nothing
Set Cn = Nothing
End Sub
Private Sub UserForm_Initialize()
Dim syf, TmpVr As Worksheet, k As Byte
Set TmpVr = Sheets("TmpSilme")
TmpVr.Unprotect "4455"
TmpVr.Cells.Clear
Hcr = 1
Dim CnSchema As ADODB.Connection
Dim RsSchema As ADODB.Recordset
Dim SqlSchema As String
Set CnSchema = New ADODB.Connection
SqlSchema = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=no"""
CnSchema.Open SqlSchema
Set RsSchema = CnSchema.OpenSchema(20)
TmpVr.Range("A1").CopyFromRecordset RsSchema
RsSchema.Close
CnSchema.Close
Set RsSchema = Nothing
Set CnSchema = Nothing
Set Cn = CreateObject("Adodb.Connection")
Set Rs = CreateObject("adodb.recordset")
Cn.Open "provider=Microsoft.ACE.OLEDB.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=no"""
SQL = "select replace([F1],'$""','') as Sayfa from [TmpSilme$C:C] where not isnull(f1) and right([f1],10)<>'Print_Area' " 'order by [F1]"
Rs.Open SQL, Cn, 1, 1 '
TmpVr.Range("B1").CopyFromRecordset Rs
Rs.Close
SQL = "select trim(left([F1],instrrev([F1],'$')-1)) as Sayfa from [TmpSilme$B:B] where not isnull(f1)"
Rs.Open SQL, Cn, 1, 1 '
TmpVr.Range("A1").CopyFromRecordset Rs
Rs.Close
SQL = "select [F1] from [TmpSilme$A:A] where not isnull(f1) and [F1] not in(" & Ekleme & ")"
Rs.Open SQL, Cn, 1, 1
TmpVr.Range("E1").CopyFromRecordset Rs
Rs.Close
SQL = "select [F1] from [TmpSilme$E:E] where not isnull(f1) order by [F1]"
Rs.Open SQL, Cn, 1, 1
TmpVr.Range("A:A").Clear
TmpVr.Range("A1").CopyFromRecordset Rs
TmpVr.Range("B:j").Clear
Rs.Close
SQL = "select [F1] from [TmpSilme$a:a] where not isnull(f1) order by [F1]"
Rs.Open SQL, Cn, 1, 1
' Eğer Hiç Kayıt Yoksa
If Rs.RecordCount = 0 Then
Rs.Close
Set Rs = Nothing
MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"
Exit Sub
End If
ComboBox1.Column = Rs.GetRows
Rs.Close
Rs.Open SQL, Cn, 1, 1
With Me.ListBox1
.ColumnCount = Rs.Fields.Count
.Column = Rs.GetRows
End With
Rs.Close
Cn.Close
Set Rs = Nothing
Set Cn = Nothing
End Sub
