ADODB.Recordset ile Combobox a 3 sütun getirmek

[hsayar]

......................
SQLStr = "SELECT DISTINCT TCK_NO FROM [DATA$]"    'kynMHBRM dosyada ilgili satırlarda sorgu yap
Set RecTcNo = New ADODB.Recordset
RecTcNo.Open SQLStr, bagTCKMLK, adOpenKeyset, adLockOptimistic
        RecTcNo.MoveFirst:        ComboBox85.Clear
            For i = 1 To RecTcNo.RecordCount
               ComboBox85.AddItem RecTcNo.Fields("TCK_NO")
               RecTcNo.MoveNext
            Next i
        RecTcNo.MoveFirst:        ComboBox85.ListIndex = 0
If CBool(RecTcNo.State And adStateOpen) = True Then RecTcNo.Close: Set RecTcNo = Nothing
'___________________________
................

yukarıdaki kodlar ,le Kapalı dosyadaki TCK_NO sütunundaki verileri ComboBox85 nesnesine ekleyebiliyoruz. Ancak aynı nesnede görünümün TCK_NO, adı, soyadı olarak olması ancak combobox85.value sonucunun yine tck_no olması mümkün olur mu?


tıpkı aynı kitaptaki sayfalardan veri alındığı gbi.

'ComboBox6.ColumnCount = 3
'ComboBox6.ColumnWidths = "75;40;50"
'ComboBox6.ListRows = "5"
'ComboBox6.RowSource = "Bilgi_Girisi!b3: D" & Cells(65536, 2).End(xlUp).Row

 

[hsayar]

Set RecTcNo = New ADODB.Recordset bağlantısında comboboxa açıldığında görünütünün aşağıdaki gibi olaması imkansızmıdır.

36427275785 ahmet kara gibi.

 

[hsayar]

örnek dosya eklenmiştir.

http://www.excel.web.tr/attachment.php?attachmentid=32968&d=1201465274

 

[hsayar]

.....................
'***************************
    SQLStr = "SELECT DISTINCT TCK_NO FROM [DATA$]"    'kynMHBRM dosyada ilgili satırlarda sorgu yap
    Dim RecTcNo As ADODB.Recordset:      Set RecTcNo = New ADODB.Recordset
    With RecTcNo
        .Open SQLStr, bagTCKMLK, adOpenKeyset, adLockOptimistic
        .MoveFirst:        ComboBox85.Clear
            For i = 1 To .RecordCount
               ComboBox85.AddItem .Fields("TCK_NO")
               .MoveNext
            Next i
        .MoveFirst:        ComboBox85.ListIndex = 0
        If CBool(.State And adStateOpen) = True Then .Close
    End With
    Set RecTcNo = Nothing
'___________________________
...................

çalışan kodlar bu ise

.....................
'***************************
    SQLStr = "SELECT DISTINCT TCK_NO FROM [DATA$]"    'kynMHBRM dosyada ilgili satırlarda sorgu yap
    Dim RecTcNo As ADODB.Recordset:      Set RecTcNo = New ADODB.Recordset
    With RecTcNo
        .Open SQLStr, bagTCKMLK, adOpenKeyset, adLockOptimistic
        .MoveFirst:        ComboBox85.Clear
            For i = 1 To .RecordCount
[color="red"]               
combobox 85, 3 kolonlu olsun 

ComboBox85.1kolonu.AddItem .Fields("TCK_NO")  
ComboBox85.2kolonu.AddItem .Fields("ad")  
ComboBox85.3kolonu.AddItem .Fields("soyad")  
olsun

[/color]

               .MoveNext
            Next i
        .MoveFirst:        ComboBox85.ListIndex = 0
        If CBool(.State And adStateOpen) = True Then .Close
    End With
    Set RecTcNo = Nothing
'___________________________
...................

demek istiyorum

rowsource olayının kapalı dosya versiyonu ama nasıl

 

[hsayar]

Sorun çözüldü daha basiti varsa yardımlarınızı bekliyorum
açıklmaları yapıldı

Private Sub USERFORM_TERMINATE()
On Error Resume Next
    If CBool(Baglanti.State And adStateOpen) = True Then Baglanti.Close: Set Baglanti = Nothing
    If CBool(BagULKE.State And adStateOpen) = True Then bagbagULKE.Close: Set BagULKE = Nothing
    If CBool(bagTCKMLK.State And adStateOpen) = True Then bagTCKMLK.Close: Set bagTCKMLK = Nothing
    If CBool(bagYKN.State And adStateOpen) = True Then bagYKN.Close: Set bagYKN = Nothing
End Sub
Private Sub UserForm_Initialize()
Call DegiskenTani
'Tanımlar
Dim i As Integer, SQLStr, SQLTcStr As String
'Değişkenler
OptionButton1.Value = 1: OptionButton3.Value = 1
 [color="red"] 
 With ComboBox85
     .ColumnCount = 3
     .ColumnWidths = "55;40;40"
     .ListRows = "10"
End With
 [/color] 
'Spreadsheet1.Sheets(2).Select
Spreadsheet1.Sheets(1).Select
    If Dir(kynMHBRM) = "" Then MsgBox kynMHBRM & " " & Chr(10) & " Dosyası Bulunamadı.", vbInformation, "Bilgi":         Exit Sub
    If Dir(kynULKE) = "" Then MsgBox kynULKE & " " & Chr(10) & " Dosyası Bulunamadı.", vbInformation, "Bilgi":           Exit Sub
    If Dir(kynTcKimNo) = "" Then MsgBox kynTcKimNo & " " & Chr(10) & " Dosyası Bulunamadı.", vbInformation, "Bilgi":     Exit Sub
    If Dir(kynYKN) = "" Then MsgBox kynYKN & " " & Chr(10) & " Dosyası Bulunamadı.", vbInformation, "Bilgi":             Exit Sub
'************************************************'bağlan>
'alt taraftan devam ediniz

......................
    Set Baglanti = New ADODB.Connection
    Baglanti.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=" & kynMHBRM
    Set BagULKE = New ADODB.Connection
    BagULKE.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=" & kynULKE
    Set bagTCKMLK = New ADODB.Connection
    bagTCKMLK.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=" & kynTcKimNo
    Set bagYKN = New ADODB.Connection
    bagYKN.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=" & kynYKN
'************************************************'bitti<
    SQLStr = "SELECT DISTINCT il FROM [ilveilce$]"    'kynMHBRM dosyada ilgili sat&#305;rlarda sorgu yap
    Dim Kayit1 As ADODB.Recordset:      Set Kayit1 = New ADODB.Recordset
    With Kayit1
        .Open SQLStr, Baglanti, adOpenKeyset, adLockOptimistic
        .MoveFirst:        ComboBox4.Clear
            For i = 1 To .RecordCount
               ComboBox4.AddItem .Fields("il")
               .MoveNext
            Next i
        .MoveFirst:        ComboBox4.ListIndex = 27
        If CBool(.State And adStateOpen) = True Then .Close
    End With
    Set Kayit1 = Nothing

'___________________________
'***************************
    SQLStr = "SELECT DISTINCT ADI FROM [DATA$]"    'kynMHBRM dosyada ilgili satırlarda sorgu yap
    Dim RecUlke As ADODB.Recordset:      Set RecUlke = New ADODB.Recordset
    With RecUlke
        .Open SQLStr, BagULKE, adOpenKeyset, adLockOptimistic
        .MoveFirst:        ComboBox84.Clear
            For i = 1 To RecUlke.RecordCount
               ComboBox84.AddItem .Fields("ADI")
               .MoveNext
            Next i
        .MoveFirst:        ComboBox84.ListIndex = 0
        If CBool(.State And adStateOpen) = True Then .Close
    End With
    Set RecUlke = Nothing

'___________________________
'***************************            'ADI, SOYADI
    '*Kaynak kitabın data sayfasında TCK_NO sütununu ara [AltSatır]
    SQLStr = "SELECT DISTINCT TCK_NO FROM [DATA$]"
    '*Kaynak kitaptan alınacak veriler için değişken tanımla[AltSatır]
    Dim RecTcNo As ADODB.Recordset:      Set RecTcNo = New ADODB.Recordset         'Kayıt değişkeni tanımla ve set et
    '*Kaynak kitaptan alınan kimlik numaralrı için dizi tanımla[AltSatır]
    Dim arrTCK()
    '*Kaynak kitaptan verileri almak için hazırlık yap[AltSatır]
        With RecTcNo
            '*bağlantıyı aç, ilk kayda git[AltSatır]
            .Open SQLStr, bagTCKMLK, adOpenKeyset, adLockOptimistic:             .MoveFirst
          '*Combobox 85i temizle[AltSatır]
            ComboBox85.Clear
            '*Kayıt (Kimlik no) sayısı kadar döngü başlat[AltSatır]
            For i = 1 To .RecordCount
 [color="red"] 
                '*Mevcut kaydı değişkene yaz[AltSatır]
                strTCK = .Fields("TCK_NO")
                '*Mevcut kaydı Spread nesnesine yaz[AltSatır]
                Spreadsheet1.Sheets(2).Cells(i, 1) = strTCK
                '*Mevcut kaydı combobox a ekle [AltSatır]
                ComboBox85.AddItem strTCK
                '*Mevcut kaydı Dizye al[AltSatır]
                ReDim Preserve arrTCK(y):  arrTCK(y) = strTCK: y = y + 1
                '*Sonraki kayda geç[AltSatır]
                .MoveNext
            '*for i = 1 satırına dön [AltSatır]
            Next i
            '*İlk kayda git [AltSatır]
            .MoveFirst
            '*comboda ilk satırı seç [AltSatır]
            'ComboBox85.ListIndex = 0
        '*Kayıt Bağlantısını kapat [AltSatır]
        If CBool(.State And adStateOpen) = True Then .Close
    End With
    '*Değişkeni sil[AltSatır]
    Set RecTcNo = Nothing [/color]

 [color="red"] 
'___________________________
''************************************************
'* kimlik no dizisinde (arrTCK) ki elaman sayısı 1 den fazla ise[AltSatır]
'*/* Not: Dizilerde sayma işlemi 0 dan başlar yani UBound(arrTCK) = 0 ise dizimiz bir elemanlıdır.
If UBound(arrTCK) >= 0 Then
    '*dizideki elaman sayısı kadar döngü kur.
    For tci = 0 To UBound(arrTCK)
    '*Kaynak kitaptan alınacak veriler için değişken tanımla[AltSatır]
    Dim RecTcN2 As ADODB.Recordset:      Set RecTcN2 = New ADODB.Recordset
    '*Verileri Sayfa yerine (kayıt sayısı kadar satır, 3 sütunlu) dizye alacağız, değişken tanımı
    Dim arrTMM()
    'Kaynak kitapta sorgulanacak başlıklar;
    basliklar = "TCK_NO, ADI, SOYADI"
    'Kaynak kitapta sorgulanacak sayfanınadı$;
    sayfaadi = "[DATA$]"
    'Kaynak kitapta sorgulanacak Sütun başlığı ve aranacak değer
    sorgu = "TCK_NO = " & arrTCK(tci)
    'Kaynak kitapta sorgulanacak tüm değerler
    SQLStr = "SELECT " & basliklar & " FROM " & sayfaadi & " WHERE " & sorgu
        ''kayıt kısaltmasını başlatıyoruz
        With RecTcN2
             '*bağlantıyı aç, ilk kayda git[AltSatır]
            .Open SQLStr, bagTCKMLK, adOpenKeyset, adLockOptimistic
         '*Verileri Sayfa yerine (kayıt sayısı kadar satır, 3 sütunlu) diziye alacağız
         '*diziyi eski değerleri unutmayacak şekilde yeniden boyutlandırıyoruz.
            ReDim Preserve arrTMM(UBound(arrTCK), 2)
            'tci satırı, 1. sütuna arrTCK elamanını eşitliyoruz
            arrTMM(tci, 0) = arrTCK(tci)
            'tci satırı, 2. sütuna bulunan Ad kaydını eşitliyoruz
            arrTMM(tci, 1) = .Fields("ADI")
            'tci satırı, 2. sütuna bulunan SoyAd kaydını eşitliyoruz
            arrTMM(tci, 2) = .Fields("SOYADI")
            'Sonraki Kayda gidiyoruz.
            .MoveNext
        'kayıt kısaltmasını bitiriyoruz
        End With
    'tci döngüsünü 1 artırıyoruz.
    Next tci
        ''kayıt kısaltmasını başlatıyoruz
        With RecTcN2
            'ilk kayda gidiyoruz
            .MoveFirst
            'bağlantı açıksa kapatıyoruz
            If CBool(.State And adStateOpen) = True Then .Close
        'kayıt kısaltmasını bitiriyoruz
        End With
    'kayıt değişkenini VE kimlik dizi değişkenini siliyoruz
    Set RecTcN2 = Nothing: Erase arrTCK
End If
 [/color]

 [color="red"] 

'___________________________
''************************************************
'ComboBox85 kısaltmasını başlat
With ComboBox85
    .Clear                                      'temizliyoruz
    For tci = 0 To UBound(arrTMM)               'tamamı dizisindeki son elamana kadar döngü kuruyoruz
        .AddItem                                'Elaman ekleme işlemin başlatıyoruz
        'combo tci satırı, 1 sütununa tamamı dizisindeki tci,0 elamanlarını eşitliyoruz
        .List(tci, 0) = arrTMM(tci, 0)
        'combo tci satırı, 2 sütununa tamamı dizisindeki tci,1 elamanlarını eşitliyoruz
        .List(tci, 1) = arrTMM(tci, 1)
        'combo tci satırı, 3 sütununa tamamı dizisindeki tci,2 elamanlarını eşitliyoruz
        .List(tci, 2) = arrTMM(tci, 2)
        '*comboda ilk satırı seç [AltSatır]
        .ListIndex = 0
    'tci değeri bir artarak  for tci satırına gider
    Next tci
'ComboBox85 kısaltmasını bitiriyoruz
End With
'tamamı (kimlik, ad, soyad) dizi değişkenini siliyoruz
Erase arrTMM  [/color]  
'___________________________
''************************************************
'******************bağlantıyı kes
'/*/* diğer nesneleri doldur
    arrCeptelKod = Array(505, 506, 530, 532, 533, 534, 535, 536, 537, 538, 542, 543, 544, 546, 547, 555, 556)
    For i = 0 To UBound(arrCeptelKod)
        ComboBox80.AddItem arrCeptelKod(i)
        ComboBox81.AddItem arrCeptelKod(i)
    Next
'MsgBox "deneme " & Spreadsheet1.Sheets(2).Cells(2, 1)
End Sub