Fonksiyon ile adodan Excel formundan excel listview doldurma

[ASMET67]

Selamlar.
Aşağıdaki fornksiyon ile excelden access formuna bağlanıp list view nesnesinde görüntüleme yapıyorum.
Yalnız Access formunda 1 den fazla kayıt olduğunda düzgün çalışıyor
Sadece bir kayit olduğunda hata veriyor.
Nasıl bir düzeltme yapmamız lazım.
Teşekkürler.

Private Sub CommandButton1_Click()
Dim Sorgu As String
Dim LWSutunAdi As Variant
LWSutunAdi = Array("MalzemeNo", "Tarih", "Ay", "YT No", "Adet", "Kod", "Malzeme Adı")
Sorgu = "Select MalzemeNo, Tarih, AyAdi, YtNo, Adet, Kod, MalzemeAdi From Malzeme"
Call LWDoldur(Me.ListView1, LWSutunAdi, Sorgu)
End Sub

Private Sub LWDoldur(LWAdi As MSForms.Control, Baslik, Sorgu As Variant)
Dim Satir, Sutun, SonSatir, SonSutun As Long
Dim veri As Variant
LWAdi.View = lvwReport
With LWAdi.ColumnHeaders
    .Clear
    For i = 0 To UBound(Baslik)
       .Add , , Baslik(i)
    Next
End With
With LWAdi
LWAdi.ListItems.Clear
Set ksm = New ADODB.Recordset
Set Bagm = New ADODB.Connection
Bagm.Open "DRIVER={Microsoft Access Driver (*.mdb)};" & "DBQ=" & ThisWorkbook.Path & "\Malzeme.mdb"
 
Set ksm = Bagm.Execute(Sorgu)
 
If Not ksm.EOF Then
    veri = WorksheetFunction.Transpose(ksm.GetRows)
Else
    LWAdi.Clear
End If
Bagm.Close
Set ksm = Nothing
Set Bagm = Nothing
SonSatir = UBound(veri, 1)
SonSutun = UBound(veri, 2)
For Satir = 1 To SonSatir
    .ListItems.Add , , veri(Satir, 1)
    If SonSutun > 2 Then
        For Sutun = 2 To SonSutun
            .ListItems(Satir).SubItems(Sutun - 1) = veri(Satir, Sutun)
        Next
    End If
Next
End With
End Sub

 

[tamer42]

Bir örnek ekleyebilirmisin,

İyi Çalışmalar.

 

[ASMET67]

ornek dosya

Access dosyasında 2 adet form var birinde tek kalem kayit var. Tekkalem kayıdda ayni kod hata veriyor. Tekalem forma bir satır daha eklediğim zaman bu sefer hata vermiyor. Bunu nasıl önleyebilirim.

 

[ExcelBrother]

Kodlar biraz havada. Ne gerek var ki fonksiyona falan. Biraz temizlemeye çalıştım. Umarım çalışır. Prosedürü şöyle değiştiriniz.

Private Sub LWDoldur(LWAdi As MSForms.Control, Baslik, Sorgu As Variant)
Dim Satir, Sutun As Long
Dim BAGm As ADODB.Connection
Dim KSm As ADODB.Recordset
LWAdi.View = lvwReport
With LWAdi.ColumnHeaders
    .Clear
    For i = 0 To UBound(Baslik)
       .Add , , Baslik(i)
    Next
End With
With LWAdi
LWAdi.ListItems.Clear
Set KSm = New ADODB.Recordset
Set BAGm = New ADODB.Connection
BAGm.Open "DRIVER={Microsoft Access Driver (*.mdb)};" & "DBQ=" & ThisWorkbook.Path & "\Malzeme.mdb"
KSm.Open Sorgu, BAGm, 1, 3 '= Bagm.Execute(Sorgu)
If Not KSm.EOF Then
    For Satir = 0 To KSm.RecordCount - 1
        For Sutun = 0 To KSm.Fields.Count - 1
            If Sutun = 0 Then
                .ListItems.Add , , KSm(Sutun)
            Else
                .ListItems(Satir + 1).SubItems(Sutun) = KSm(Sutun)
            End If
        Next
    KSm.MoveNext
    Next
End If
BAGm.Close
Set KSm = Nothing
Set BAGm = Nothing
End With
End Sub

 

[erkankamilonas]

Option Base 1
Private Sub UserForm_Initialize()
Dim con As Connection, rec As Recordset
SutunAdi = Array("MalzemeNo", "Tarih", "Ay", "YT No", "Adet", "Kod", "Malzeme Adı")

ListView1.ListItems.Clear

For byt = 1 To UBound(SutunAdi)
ListView1.ColumnHeaders.Add , , SutunAdi(byt)
Next byt

Set con = New Connection
con.Provider = "Microsoft.Jet.OLEDB.4.0"
con.ConnectionString = ThisWorkbook.Path & "\Malzeme.mdb"
con.Open
Set rec = New ADODB.Recordset
rec.Open Source:= _
"SELECT * FROM [dene_form]", _
ActiveConnection:=con, CursorType:=adOpenKeyset, _
LockType:=adLockOptimistic
On Error Resume Next
Do Until rec.EOF
ListView1.ListItems.Add , , rec![MalzemeNo]
With ListView1.ListItems(ListView1.ListItems.Count)
.SubItems(1) = rec![Tarih]
.SubItems(2) = rec![AyAdi]
.SubItems(3) = rec![YtNo]
.SubItems(4) = rec![Adet]
.SubItems(5) = rec![Kod]
.SubItems(6) = rec![MalzemeAdi]
End With
rec.MoveNext
Loop
con.Close
End Sub

 

[ASMET67]

sn ExcelBrother vbmenu_register("postmenu_277934", true); ve erkankamilonas vbmenu_register("postmenu_277951", true); cevaplarınız için teşekkürler.
Proserure şu sebebten ihtiyaç duyulorum.

çalışmamda 15 adet form var ve her formda listview nesnesine veri aldırıyorum. Konlari kısaltmak için fonk siyon kulalnıyorum.
Birde bu şekilde daha hızlı olduğunu duymuştum.
Kayıtlarım çok fazla sorgulamaların hızlı olması lazım. Onerdiğiniz bir başka yöntem varmı ?

 

[ExcelBrother]

Private Sub prosedürünüz gayet mantıklı ve pratik. Ben sadece takılmak için yazmıştım. Sadece bir dim ile ado nesneleri tanımnlanmamış onları tnaımlayıp kodu klasik hale getirdim. Hız konusunda ilk kod daha iyidir, özellikle listbox kullanımında. Dizinin ikinci boyutunu bulan kod ikinci boyut olmadığından çalışmıyor.

 

[ASMET67]

Teşşükler.
Sizin düzelemeniz çalışıyor.
Hız konusunda ilk kod dediğiniz siniz yadığınız kodmu?

 

[erkankamilonas]

Public con As Connection, rec As Recordset, sorgu As String

Function Baglan(VeriTabani As String, TabloAdi As String)
Set con = New Connection
con.Provider = "Microsoft.Jet.OLEDB.4.0"
con.ConnectionString = ThisWorkbook.Path & "\" & VeriTabani & ".mdb"
con.Open
sorgu = "SELECT * FROM " & TabloAdi
Set rec = New ADODB.Recordset
rec.Open sorgu, con, 1, 3
End Function


Private Sub UserForm_Initialize()
SutunAdi = Array("MalzemeNo", "Tarih", "Ay", "YT No", "Adet", "Kod", "Malzeme Adı")

ListView1.ListItems.Clear

For byt = 1 To UBound(SutunAdi)
ListView1.ColumnHeaders.Add , , SutunAdi(byt)
Next byt

Call Baglan(VeriTabani:="Malzeme", TabloAdi:="Malzeme")
On Error Resume Next
Do Until rec.EOF
ListView1.ListItems.Add , , rec![MalzemeNo]
With ListView1.ListItems(ListView1.ListItems.Count)
.SubItems(1) = rec![Tarih]
.SubItems(2) = rec![AyAdi]
.SubItems(3) = rec![YtNo]
.SubItems(4) = rec![Adet]
.SubItems(5) = rec![Kod]
.SubItems(6) = rec![MalzemeAdi]
End With
rec.MoveNext
Loop
con.Close
End Sub

Sayın ASMET67 buda Function ile çözüm.

Hızınızı da kendiniz ölçebilirsiniz.
Şöyle ki;

İşlem yapmaya başladığınız kodlarınızın başına;
zaman = Now
Sonuna
MsgBox Now - zaman yazın bir deneyin hangisi daha hızlı bizde görmüş oluruz.

 

[123455]

mrb
benim de hücrede açılan listeye kapalı olan başka bir excel belgesinden veya mssql veya mysql deki bir tablodan alan bağlamakla alakalı bi sıkıntım var yardımcı olabilirseniz sevinirim.

sorunum şuki excelde yaptığımız çekilistesinin (b) kolonunda açılır listeden ürünün kodunu seçtiriyoruz, (c) kolonunda düşeyara ile aynı tablodan ürünün ismini getiriyoruz, yandaki diğer kolonlarda da rengi, kalitesi, ek özelliği, dekoru, fiyatı ve muhasebe hes.planı kodunu getittiriyoruz. bu bilgileride xml ile logoya direkt irsaliye olarak aktarıyoruz. Ben bunları kapalı bir excel dosyasından veya logonun database'inden çekmek istiyorum. Bu listeyi mail attığımız için boyut çok fazla önem taşıyor ve şu anda ürün yoğunluğundan dolayı boyut 3 mb'ı buldu.
yardımcı olursanız sevinirim ben hala çözemedim