Listbox Da Verilerin Listelenmesi Hakkında.

Private Sub UserForm_Initialize() Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim sqlSorgusu As String Dim i As Integer ' Veritabanı bağlantısını kur Set cn = New ADODB.Connection cn.ConnectionString = "Driver={ODBC Driver 17 for Sql Server};" & _ "Server=OĞUZ\SQLEXPRESS;" & _ "Database=db_Personel;" & _ "Trusted_Connection=Yes;" On Error GoTo HataBaglanti cn.Open On Error GoTo 0 ' Hata yakalamayı kapat sqlSorgusu = "SELECT * FROM tbl_Personel;" Set rs = New ADODB.Recordset On Error GoTo HataVeriOku rs.Open sqlSorgusu, cn, adOpenStatic, adLockReadOnly On Error GoTo 0 ' ListBox'ın sütun sayısını ayarla (tablodaki alan sayısı kadar) lstPersonel.ColumnCount = rs.Fields.Count ' Debug.Print "ColumnCount değeri: " & lstPersonel.ColumnCount ' ListBox'a verileri yükle If Not rs.EOF Then Do While Not rs.EOF ' Her bir kayıt için bir dizi oluştur Dim personelBilgileri() As Variant ReDim personelBilgileri(rs.Fields.Count - 1) ' Kayıttaki tüm alanları diziye aktar For i = 0 To rs.Fields.Count - 1 personelBilgileri(i) = rs.Fields(i).Value Next i ' Diziyi ListBox'a bir satır olarak ekle lstPersonel.AddItem Join(personelBilgileri, vbTab) ' Alanları sekme ile ayır ' lstPersonel.AddItem Join(personelBilgileri, ";") ' Sekme yerine noktalı virgül kullan rs.MoveNext Loop End If ' ListBox'ın sütun sayısını tekrar ayarla (emin olmak için) lstPersonel.ColumnCount = rs.Fields.Count ' Başlık satırını ekle lstPersonel.AddItem "ID" & vbTab & "Ad Soyad" & vbTab & "Doğum Tarihi" & vbTab & "..." ' Diğer başlıkları da ekleyin ' lstPersonel.ColumnWidths = "30;50;50;50;50;50;50;50;50;50;50;50;50;50;50" rs.Close cn.Close Set rs = Nothing Set cn = Nothing Exit Sub HataBaglanti: MsgBox "Veritabanına bağlanırken bir hata oluştu: " & Err.Description, vbCritical ' If Not cn Is Nothing Then If cn.State = adStateOpen Then cn.Close Set cn = Nothing HataVeriOku: MsgBox "Personel verilerini okurken bir hata oluştu: " & Err.Description, vbCritical If Not rs Is Nothing Then If rs.State = adStateOpen Then rs.Close Set rs = Nothing End If If Not cn Is Nothing Then If cn.State = adStateOpen Then cn.Close Set cn = Nothing End If End If End Sub

If Not rs.EOF Then Do While Not rs.EOF ' Her bir kayıt için bir dizi oluştur Dim personelBilgileri() As Variant ReDim personelBilgileri(rs.Fields.Count - 1) ' Kayıttaki tüm alanları diziye aktar For i = 0 To rs.Fields.Count - 1 personelBilgileri(i) = rs.Fields(i).Value Next i ' Diziyi ListBox'a bir satır olarak ekle lstPersonel.AddItem Join(personelBilgileri, vbTab) ' Alanları sekme ile ayır ' lstPersonel.AddItem Join(personelBilgileri, ";") ' Sekme yerine noktalı virgül kullan rs.MoveNext Loop End If

Kod:

Private Sub UserForm_Initialize()



    Dim cn As ADODB.Connection

    Dim rs As ADODB.Recordset

    Dim sqlSorgusu As String

    Dim i As Integer

    Dim rowIndex As Long

    Dim alanSayisi As Integer



    Set cn = New ADODB.Connection

    cn.ConnectionString = "Driver={ODBC Driver 17 for SQL Server};" & _

                          "Server=OĞUZ\SQLEXPRESS;" & _

                          "Database=db_Personel;" & _

                          "Trusted_Connection=Yes;"

    On Error GoTo HataBaglanti

    cn.Open

    On Error GoTo 0



    sqlSorgusu = "SELECT * FROM tbl_Personel;"

    Set rs = New ADODB.Recordset

    On Error GoTo HataVeriOku

    rs.Open sqlSorgusu, cn, adOpenStatic, adLockReadOnly

    On Error GoTo 0



    If rs.EOF Then GoTo TemizleHerşey



    alanSayisi = rs.Fields.Count



    With lstPersonel

        .Clear

        .ColumnCount = alanSayisi

        .ColumnWidths = String(alanSayisi - 1, "80;") & "80"

    End With



    Do While Not rs.EOF

        ' Güvenli AddItem ile ilk sütunu ekle

        On Error Resume Next

        lstPersonel.AddItem NzText(rs.Fields(0).Value)

        If Err.Number <> 0 Then Exit Do ' additem başarısızsa çık

        On Error GoTo 0



        rowIndex = lstPersonel.ListCount - 1



        For i = 1 To alanSayisi - 1

            On Error Resume Next

            lstPersonel.List(rowIndex, i) = NzText(rs.Fields(i).Value)

            On Error GoTo 0

        Next i



        rs.MoveNext

    Loop



TemizleHerşey:

    rs.Close: cn.Close

    Set rs = Nothing: Set cn = Nothing

    Exit Sub



HataBaglanti:

    MsgBox "Veritabanına bağlanamadı: " & Err.Description, vbCritical

    Resume TemizleHerşey



HataVeriOku:

    MsgBox "Veri okunamadı: " & Err.Description, vbCritical

    Resume TemizleHerşey

End Sub



Private Function NzText(val As Variant) As String

    If IsNull(val) Or IsEmpty(val) Then

        NzText = ""

    Else

        NzText = CStr(val)

    End If

End Function