teşekkürler @feraz bey dediğiniz gibi yapınca çalıştı
ComboBoxda Sayfaları Göstermek
çok da gerekli değil ve hatta gereksiz bile denilebilir ama hem çok uğraştırdığından o kadar emek boşa gitmesin diye hem de 2. ve farklı bir yöntemi göstermek için paylaştım, sağolsun @feraz beyin yardımıyla çözüldü.
2 ekleme var
1 - yeni bir sayfa eklendi
2 - Activex Data Object eklendi
form başlatılırken olayı
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
Per-7_hyRecordSet.rar
(Dosya Boyutu: 286,86 KB | İndirme Sayısı: 3)
OpenSchema yöntemi işi karıştırdığı için daha basit bir yöntem kullandım
referanslara Activex Data Object eklemeye de gerek kalmadı
form başına eklenecek kodlar
referanslara Activex Data Object eklemeye de gerek kalmadı
form başına eklenecek kodlar
Option Compare Text
Const Ekleme As String = "'ŞABLON','Sayfa1','liste','TmpSilme'"
Dim Sql As String
Dim Cn As Object
Dim Rs As Object
Private Sub UserForm_Initialize()
Dim syf, TmpVr As Worksheet, k As Byte
Set TmpVr = Sheets("TmpSilme")
TmpVr.Unprotect "4455"
TmpVr.Cells.Clear
Hcr = 1
For Each syf In Worksheets
TmpVr.Range("a" & Hcr) = syf.Name
Hcr = Hcr + 1
Next syf
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 [F1] from [TmpSilme$A:A] where not isnull(f1) and [F1] not in(" & Ekleme & ")"
Rs.Open SQL, Cn, 1, 1
TmpVr.Range("B1").CopyFromRecordset Rs
Rs.Close
SQL = "select [F1] from [TmpSilme$B:B] where not isnull(f1) order by [F1]"
Rs.Open SQL, Cn, 1, 1
TmpVr.Range("A:A").Clear
TmpVr.Range("A1").CopyFromRecordset Rs
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 SubPrivate Sub ComboBox1_Change()
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(10/05/2020, 11:37)berduş yazdı: Const Ekleme As String = "'ŞABLON','Sayfa1','liste','TmpSilme'"listbox ve comboboxa eklenmesini istemediğiniz sayfaları formun en başındaki Ekleme sabitine; araya virgül, başına ve sonuna tek tırnak koyarak, ekleyebilirsiniz
mesela "falancaSayfa" adlı sayfayı liste kutularına eklemek istemiyorsanız
Const Ekleme As String = "'ŞABLON','Sayfa1','liste','TmpSilme','falancaSayfa'"
(10/05/2020, 11:37)berduş yazdı: OpenSchema yöntemi işi karıştırdığı için daha basit bir yöntem kullandımOpenschmea ya zaten gerek yoktu.Açıkçası kodda görmiştüm incelememiştim çalışsın yeterliydi.Dedim berduş hocamız yine olağanüstü işler peşinde
referanslara Activex Data Object eklemeye de gerek kalmadı
Konuyu Okuyanlar: 1 Ziyaretçi
