CheckBox tuşunu aktif ederek işlem yapma..

[Hacı Bayram ÖZKAN]

İyi akşamlar arkadaşlar:
Aşağıdaki kodla kapalı dosyamın LİSTE sayfasından verileri alıyorum.

Private Sub UserForm_Initialize()
ListBox1.ColumnCount = 4
ListBox1.ColumnWidths = "40;85;75;70"
Dim a As Long, dosyayolu As String, sorgu As String, con As Object, rs
ReDim ls(1 To 4, 1 To 1)
dosyayolu = "D:\Belgelerim\Personel\PERSONEL LİSTESİ.xlsm"
Set con = VBA.CreateObject("adodb.Connection")
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
dosyayolu & ";Extended Properties = ""Excel 12.0 Macro;HDR=yes"";"
sorgu = "select Sicili,Adı,Soyadı,[Tc Kimlik No] from[LİSTE$] where sicili is not null "
Set rs = con.Execute(sorgu)
Do Until rs.EOF
a = a + 1
ReDim Preserve ls(1 To 4, 1 To a)
ls(1, a) = rs!Sicili
ls(2, a) = rs!Adı
ls(3, a) = rs!Soyadı
ls(4, a) = rs![Tc Kimlik No]
rs.MoveNext
Loop
con.Close
End Sub

Aynı dosyamın LİSTE ve TÜM sayfalarında verileri ise bu kodla;

Private Sub UserForm_Initialize()
ListBox1.ColumnCount = 4
ListBox1.ColumnWidths = "40;85;75;70"
Dim a As Long, dosyayolu As String, sorgu As String, con As Object, rs
ReDim ls(1 To 4, 1 To 1)
'Application.ScreenUpdating = False
dosyayolu = "D:\Belgelerim\Personel\PERSONEL LİSTESİ.xlsm"
Set con = VBA.CreateObject("adodb.Connection")
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
dosyayolu & ";Extended Properties = ""Excel 12.0 Macro;HDR=yes"";"

For Each jx In Array("LİSTE", "TÜM")
sorgu = "select Sicili,Adı,Soyadı,[Tc Kimlik No] from[" & jx & "$] where sicili is not null "
Set rs = con.Execute(sorgu)
Do Until rs.EOF
a = a + 1
ReDim Preserve ls(1 To 4, 1 To a)
ls(1, a) = rs!Sicili
ls(2, a) = rs!Adı
ls(3, a) = rs!Soyadı
ls(4, a) = rs![Tc Kimlik No]
rs.MoveNext
Loop
Next
con.Close
End Sub

Benim isteğim
CheckBox1 aktif edince her iki sayfada arama yapsın pasif edince sadece LİSTE sayfasını getirsin.

Ben bu kodu denedim olmadı.

Private Sub UserForm_Initialize()
ListBox1.ColumnCount = 4
ListBox1.ColumnWidths = "40;85;75;70"
Dim a As Long, dosyayolu As String, sorgu As String, con As Object, rs
ReDim ls(1 To 4, 1 To 1)
'Application.ScreenUpdating = False
dosyayolu = "D:\Belgelerim\Personel\PERSONEL LİSTESİ.xlsm"
Set con = VBA.CreateObject("adodb.Connection")
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
dosyayolu & ";Extended Properties = ""Excel 12.0 Macro;HDR=yes"";"

If CheckBox1.Value = True Then

For Each jx In Array("LİSTE", "TÜM")
sorgu = "select Sicili,Adı,Soyadı,[Tc Kimlik No] from[" & jx & "$] where sicili is not null "

Next
Else

sorgu = "select Sicili,Adı,Soyadı,[Tc Kimlik No] from[LİSTE$] where sicili is not null "

End If


Set rs = con.Execute(sorgu)
Do Until rs.EOF
a = a + 1
ReDim Preserve ls(1 To 4, 1 To a)
ls(1, a) = rs!Sicili
ls(2, a) = rs!Adı
ls(3, a) = rs!Soyadı
ls(4, a) = rs![Tc Kimlik No]
rs.MoveNext
Loop
Next
con.Close
End Sub

Nasil bir değişiklik yapmalıyım herkese iyi geceler.

 

[Ömer]

Merhaba,

Deneyiniz.

Private Sub UserForm_Initialize()
    
    Dim a As Long, dosyayolu As String, sorgu As String, con As Object, rs
    ListBox1.ColumnCount = 4
    ListBox1.ColumnWidths = "40;85;75;70"
    ReDim ls(1 To 4, 1 To 1)
    dosyayolu = "D:\Belgelerim\Personel\PERSONEL LİSTESİ.xlsm"
    Set con = VBA.CreateObject("adodb.Connection")
    con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
    dosyayolu & ";Extended Properties = ""Excel 12.0 Macro;HDR=yes"";"

    If CheckBox1.Value = True Then
    
        For Each jx In Array("LİSTE", "TÜM")
            sorgu = "select Sicili,Adı,Soyadı,[Tc Kimlik No] from[" & jx & "$] where sicili is not null "
            Set rs = con.Execute(sorgu)
            Do Until rs.EOF
            a = a + 1
            ReDim Preserve ls(1 To 4, 1 To a)
            ls(1, a) = rs!Sicili
            ls(2, a) = rs!Adı
            ls(3, a) = rs!Soyadı
            ls(4, a) = rs![Tc Kimlik No]
            rs.MoveNext
            Loop
        Next
    
    Else
    
        sorgu = "select Sicili,Adı,Soyadı,[Tc Kimlik No] from[LİSTE$] where sicili is not null "
        Set rs = con.Execute(sorgu)
        Do Until rs.EOF
        a = a + 1
        ReDim Preserve ls(1 To 4, 1 To a)
        ls(1, a) = rs!Sicili
        ls(2, a) = rs!Adı
        ls(3, a) = rs!Soyadı
        ls(4, a) = rs![Tc Kimlik No]
        rs.MoveNext
        Loop
    
    End If
    
    con.Close
    
End Sub

 

[Hacı Bayram ÖZKAN]

Sayın Ömer bey; ancak deneme fırsatım oldu yenice denedim ama TÜM sayfasındaki verileri getirmedi. LİSTE sayfası geldi.

 

[Ömer]

Kodlar form açılırken çalışıyor. Bu yüzden açılış esnasında CheckBox1 seçili gelmiyorsa sadece Liste çalışır.
Sizin verileri çağırma şeklini değiştirmeniz gerekir. Ya butonla yada CheckBox1 seçimi ile.

Yani başlık satırını;

Private Sub UserForm_Initialize()

değil de aşağıdaki gibi yazarsanız CheckBox1 seçimine göre veriler gelir. Yada butona bağlarsınız.

Private Sub CheckBox1_Click()

.

 

[Hacı Bayram ÖZKAN]

Selamün Aleyküm Ömer Bey; anlattığınızı anlamakta biraz zorlandım ama sonunda anlayarak yaptım çalıştı, elinize sağlık teşekkür ederim. İyi geceler iyi ki varsınız? Eksik olmayın efendim.