+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: ComboBoxda Sayfaları Göstermek (/konu-comboboxda-sayfalari-gostermek.html)
RE: ComboBoxda Sayfaları Göstermek - feraz - 09/05/2020
Dizi olayı ile kod aşağıda abey.
Private Sub ComboBox1_Change()
Const Ekleme As String = "|ÞABLON|Sayfa1|liste|"
Dim syf As Worksheet
Dim arr, say As Integer
ReDim arr(1 To Worksheets.Count)
For Each syf In Worksheets
If InStr(1, Ekleme, "|" & syf.Name & "|", 1) = 0 Then
If LCase(syf.Name) Like LCase(Me.ComboBox1.Value) & "*" Then
say = say + 1
ReDim Preserve arr(1 To say)
arr(say) = syf.Name
End If
End If
Next
Me.ListBox1.Clear
If say > 0 Then Me.ListBox1.List = arr
If Me.ComboBox1.Value = Empty Then Me.ListBox1.Clear
Set syf = Nothing
Erase arr
End Sub@berduş hocam yinede yazayım C sürücüsüne Yedek adında yaedekleme yapılıyor excelin kapanma olayına yazmışlar aklınızda olsun.
RE: ComboBoxda Sayfaları Göstermek - berduş - 10/05/2020
amacım sadece listbox'a recordsetten veri almak olduğu için diğer kodları sildim, excele TmpSilme adlı yeni bir sayfa ekledim
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
If InStr(1, Ekleme, "|" & syf.Name & "|", 1) = 0 Then
TmpVr.Range("a" & Hcr) = syf.Name
Hcr = Hcr + 1
End If
Next syf
Set Cn = CreateObject("Adodb.Connection")
Cn.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=no"""
Cn.Open
SQL = "select * from [TmpSilme$A:A] where [F1]<>'' order by [F1]"
Set Rs = CreateObject("adodb.recordset")
Rs.Open SQL, Cn, 3, 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
'With Me.ListBox1
' .ColumnCount = Rs.Fields.Count
' .Column = Rs.GetRows
'' .ColumnHeads = True
'End With
Rs.Close
Set Rs = Nothing
End Sub
dizi kullanmayı da denedim, diziye değeri recordsetten alıp listeye eklemeyi arr ile yaptım olmadı.
Re: Comboboxda Sayfaları Göstermek - m_demir - 10/05/2020
Çok teşekkürler Hocalarım ellerinize sağlık.
Hocalarım mesaj 27 deki kodu uygulayabildim. 28 mesajdaki kodlarda uygulanması gerekiyorsa eklediğim dosyaya uygularmısınız. Kalması gereken kodları silmeden.
RE: ComboBoxda Sayfaları Göstermek - feraz - 10/05/2020
Kodu alttaki gib yaptım çalıştı.
ComboBox1.Column = Rs.GetRowsPrivate 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
If InStr(1, Ekleme, "|" & syf.Name & "|", 1) = 0 Then
TmpVr.Range("a" & Hcr) = syf.Name
Hcr = Hcr + 1
End If
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 * 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
With Me.ListBox1
.ColumnCount = Rs.Fields.Count
.Column = Rs.GetRows
' .ColumnHeads = True
End With
Rs.Close
Set Rs = Nothing
End SubRE: ComboBoxda Sayfaları Göstermek - berduş - 10/05/2020
Bende de tam tersi oluyor)
RE: ComboBoxda Sayfaları Göstermek - feraz - 10/05/2020
Buda çalışan hali.Önce recordset ile listboxa alındı recordset kapatılp tekrar açıldı ve comboya alındı veriler.
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
If InStr(1, Ekleme, "|" & syf.Name & "|", 1) = 0 Then
TmpVr.Range("a" & Hcr) = syf.Name
Hcr = Hcr + 1
End If
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 * 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
With Me.ListBox1
.ColumnCount = Rs.Fields.Count
.Column = Rs.GetRows
' .ColumnHeads = True
End With
Rs.Close
Rs.Open SQL, Cn, 1, 1
ComboBox1.Column = Rs.GetRows
Rs.Close
Cn.Close
Set Rs = Nothing
Set Cn = Nothing
End SubBöylede oluyor önemli olan recordset kapatmak combo başta yada sonda olması şart değil.
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
If InStr(1, Ekleme, "|" & syf.Name & "|", 1) = 0 Then
TmpVr.Range("a" & Hcr) = syf.Name
Hcr = Hcr + 1
End If
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 * 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
' .ColumnHeads = True
End With
Rs.Close
Cn.Close
Set Rs = Nothing
Set Cn = Nothing
End Sub