ComboBoxda Sayfaları Göstermek

ComboBoxda Sayfaları Göstermek - Baskı Önizleme

+- 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)

Sayfalar: 1 2 3 4 5 6 7 8 9

RE: ComboBoxda Sayfaları Göstermek - berduş - 10/05/2020

teşekkürler @feraz bey dediğiniz gibi yapınca çalıştı

RE: ComboBoxda Sayfaları Göstermek - feraz - 10/05/2020

Rica ederim abey.

RE: ComboBoxda Sayfaları Göstermek - berduş - 10/05/2020

ç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ı

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

combobox değiştiğinde olayı

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

RE: ComboBoxda Sayfaları Göstermek - berduş - 10/05/2020

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

Option Compare Text

Const Ekleme As String = "'ŞABLON','Sayfa1','liste','TmpSilme'"

Dim Sql As String

Dim Cn As Object

Dim Rs As Object

UserForm_Initialize olayının kodları OpenSchema yöntemi işi karıştırdığı için sildim

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 Sub

bu da açılır kutu değiştiğinde olayı

Private 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

RE: ComboBoxda Sayfaları Göstermek - berduş - 10/05/2020

(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'"

RE: ComboBoxda Sayfaları Göstermek - feraz - 10/05/2020

(10/05/2020, 11:37)berduş yazdı: 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ı

Openschmea 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 Img-grin