Skip to main content

AccessTr.neT


ComboBoxda Sayfaları Göstermek

ComboBoxda Sayfaları Göstermek

#25
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.
Cevapla
#26
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ı.
.rar listbox_recordset_hy.rar (Dosya Boyutu: 282,09 KB | İndirme Sayısı: 2)
Cevapla
#27
Ç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.
.rar PER.7.rar (Dosya Boyutu: 291,75 KB | İndirme Sayısı: 1)
Son Düzenleme: 10/05/2020, 00:26, Düzenleyen: m_demir.
Cevapla
#28
Kodu alttaki gib yaptım çalıştı.
ComboBox1.Column = Rs.GetRows
olunca çalışmıyor onada bakacağım.

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
Set Rs = Nothing

End Sub
Cevapla
#29
Bende de tam tersi oluyor)
Cevapla
#30
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 Sub

Bö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
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task