• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Bul aktar ve yazdır

S

sedat2161

Katılım
1 Ekim 2017
Mesajlar
694
Excel Vers. ve Dili
2019 türkçe
Merhaba hayırlı sabahlar arkadaşlar. Ekli bordro sayfamda UserForm üzerine aktardığım Textbox ile (farklı bir aramada olabilir) Bordro sayfasından F sutununda bulunan mahalle adından bilgileri bulup Fiş sayfasına aktarma yapmak istiyorum. Yardımcı olursanız çok memnun olurum.
Bordro: d- Fiş: c6
Bordro: e- Fiş: c7
Bordro: f- Fiş: c8
Bordro: ı- Fiş: b11
Bordro: L- Fiş: d11
Bordro: m- Fiş: e11
Bordro: n- Fiş: f11
Bordro: p- Fiş: g13
Bordro: q- Fiş: h14 olacak şekilde hayırlı günler diliyorum.
 

Ekli dosyalar

Dosyanızla ilgili güzel işler yapmaya çalışıyorum ama bir yerde nedense istediğim sonucu alamıyorum. Sayın @Erdem_34 aşağıdaki kodlarda Sayfa1'in B2 hücresine sorgu sonucu gelirken Listview'e gelmemesinin nedenini açıklar ve çözümünü gösterirse büyük bir ilerleme kaydedeceğiz:

Amacım Listbox1'de seçilen ilçe ve listbox2'de seçilen mahalleye göre bordro sayfasından ado ile sorgu yapıp, Listview1'in ilk sütununa sıra numarası yazıp diğer sütunlara da bordrodaki bilgileri aktarmak:

PHP: 
Private Sub ListBox2_Click()
Dim con As Object
Dim rs As Object
Dim a As Integer
Set con = CreateObject("adodb.connection")
Set s1 = Sheets("BORDRO")
son = s1.Cells(Rows.Count, "E").End(3).Row

con.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.FullName & _
";extended properties=""excel 8.0;hdr=yes;Imex=1"""

evnsorgu = "select TC, [ADI SOYADI],3,[Çalışma Günü],[Aylık Tutar],[14 Günlük], Toplam, [Damga Vergisi], [İcra Kesintisi], [Kira Kesintisi]," & _
            "[Diğer Kesinti], [Kesinti Toplamı], [Net Ele Geçen] from[" & s1.Name & "$B6:Q" & son & "] where [İLÇE] = '" & ListBox1.Value & "' and " & _
            "[MAHALLE] = '" & ListBox2.Value & "'"

Set rs = CreateObject("adodb.recordset")
rs.Open evnsorgu, con, 1, 1
Sheets("Sayfa1").[B2].CopyFromRecordset rs
If rs.RecordCount > 0 Then
    With ListView1
        .ListItems.Clear
        .FullRowSelect = True
        .View = lvwReport
    
        Application.ScreenUpdating = False
            Do While Not rs.EOF
                ListView1.ListItems.Add , , rs(0).Value
                ListView1.ListItems(ListView1.ListItems.Count).SubItems(0) = 1
                For a = 1 To rs.Fields.Count
                    ListView1.ListItems(ListView1.ListItems.Count).SubItems(a) = rs.Fields(a).Value
                Next a
                rs.MoveNext
            Loop
            .FullRowSelect = True
            .Gridlines = True
        Application.ScreenUpdating = True
        
    End With
End If
Set rs = Nothing
Set con = Nothing
End Sub
 

Ekli dosyalar

Merhaba,

Listview nesnesini hiç kullanmadım ama bende con.open'da hata verdi.
Aşağıdaki gibi değiştirerek deneyebilir misiniz.

Kod: 
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
 
YUSUF44' Alıntı:
Dosyanızla ilgili güzel işler yapmaya çalışıyorum ama bir yerde nedense istediğim sonucu alamıyorum. Sayın @Erdem_34 aşağıdaki kodlarda Sayfa1'in B2 hücresine sorgu sonucu gelirken Listview'e gelmemesinin nedenini açıklar ve çözümünü gösterirse büyük bir ilerleme kaydedeceğiz:

Amacım Listbox1'de seçilen ilçe ve listbox2'de seçilen mahalleye göre bordro sayfasından ado ile sorgu yapıp, Listview1'in ilk sütununa sıra numarası yazıp diğer sütunlara da bordrodaki bilgileri aktarmak:

PHP: 
Private Sub ListBox2_Click()
Dim con As Object
Dim rs As Object
Dim a As Integer
Set con = CreateObject("adodb.connection")
Set s1 = Sheets("BORDRO")
son = s1.Cells(Rows.Count, "E").End(3).Row

con.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.FullName & _
";extended properties=""excel 8.0;hdr=yes;Imex=1"""

evnsorgu = "select TC, [ADI SOYADI],3,[Çalışma Günü],[Aylık Tutar],[14 Günlük], Toplam, [Damga Vergisi], [İcra Kesintisi], [Kira Kesintisi]," & _
            "[Diğer Kesinti], [Kesinti Toplamı], [Net Ele Geçen] from[" & s1.Name & "$B6:Q" & son & "] where [İLÇE] = '" & ListBox1.Value & "' and " & _
            "[MAHALLE] = '" & ListBox2.Value & "'"

Set rs = CreateObject("adodb.recordset")
rs.Open evnsorgu, con, 1, 1
Sheets("Sayfa1").[B2].CopyFromRecordset rs
If rs.RecordCount > 0 Then
    With ListView1
        .ListItems.Clear
        .FullRowSelect = True
        .View = lvwReport
   
        Application.ScreenUpdating = False
            Do While Not rs.EOF
                ListView1.ListItems.Add , , rs(0).Value
                ListView1.ListItems(ListView1.ListItems.Count).SubItems(0) = 1
                For a = 1 To rs.Fields.Count
                    ListView1.ListItems(ListView1.ListItems.Count).SubItems(a) = rs.Fields(a).Value
                Next a
                rs.MoveNext
            Loop
            .FullRowSelect = True
            .Gridlines = True
        Application.ScreenUpdating = True
       
    End With
End If
Set rs = Nothing
Set con = Nothing
End Sub
Genişletmek için tıkla ...
Hocam ilginiz için çok teşekkür ederim
 
Erdem_34' Alıntı:
Merhaba,

Listview nesnesini hiç kullanmadım ama bende con.open'da hata verdi.
Aşağıdaki gibi değiştirerek deneyebilir misiniz.

Kod: 
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
Genişletmek için tıkla ...
Olmuyor maalesef. Listviewe veriler yüklenmiyor. Kontrol için br satırda da excel sayfasına yükletiyorum, o satır çalışıyor. Listview'e alma yönteminde bir hata var ama bilemiyorum nedir.
 
Ado bağlantısında sorun yok ama 32 Bit Office'de ListView nesnesi olmadığı için UserForm açılışında hata veriyor. Onun yerine ListBox kullanmak lazım ...

Eğer bu proje bir .Net projesi olsaydı, o zaman Framework sınıflarının içinden ListView rahatlıkla kullanılabilirdi.

Not: Eğer ListView kodlarınızdan eminseniz; RS'i sayfaya yazdıran kodu silin, sadece ListView nesnesine yazdırın...

Diğer yandan, ListView nesnesi hakkında bahsettiğim problemden dolayı eğer onun yerine ListBox4 nesnesini eklerseniz, kullanacağınız kod;

Kod: 
ListBox4.ColumnCount = rs.Fields.Count

If rs.RecordCount > 0 Then
    ListBox4.Column = rs.GetRows
End If


Eğer sonuçlar beklediğiniz gibiyse; ondan sonra işin makyaj kısmına geçip, ListBox4 nesnesinin sütun genişliklerini, başlıklarını vs halledersiniz.

.
 
Son düzenleme:
@YUSUF44,

Deneyiniz.

C++: 
Private Sub ListBox2_Click()
    Dim Con As Object, Rs As Object, S1 As Worksheet, Son As Long, Sorgu As String, X As Integer
    
    Set Con = CreateObject("AdoDb.Connection")
    Set S1 = Sheets("BORDRO")
    
    Son = S1.Cells(Rows.Count, "E").End(3).Row
    
    Con.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
    
    Sorgu = "Select Sıra, TC, [ADI SOYADI], 3, [Çalışma Günü], [Aylık Tutar], [14 Günlük], Toplam, [Damga Vergisi], [İcra Kesintisi], [Kira Kesintisi], " & _
            "[Diğer Kesinti], [Kesinti Toplamı], [Net Ele Geçen] From [" & S1.Name & "$B6:Q" & Son & "] Where [İLÇE] = '" & ListBox1.Value & "' And " & _
            "[MAHALLE] = '" & ListBox2.Value & "'"
    
    Set Rs = CreateObject("AdoDb.Recordset")
    Rs.Open Sorgu, Con, 1, 1
    
    Application.ScreenUpdating = False
    
    Sheets("Sayfa1").Range("A2").CopyFromRecordset Rs
    
    If Rs.RecordCount > 0 Then
        With ListView1
            .ListItems.Clear
            .FullRowSelect = True
            .View = lvwReport
            .Gridlines = True
            .LabelEdit = lvwManual
            
            Rs.MoveFirst
            
            Do While Not Rs.EOF
                .ListItems.Add , , Rs.Fields(0).Value
                For X = 1 To Rs.Fields.Count - 1
                    If Not IsNull(Rs.Fields(X).Value) Then
                        .ListItems(.ListItems.Count).SubItems(X) = Rs.Fields(X).Value
                    End If
                Next
                Rs.MoveNext
            Loop
            
        End With
    End If
    
    Rs.Close
    Con.Close
    
    Application.ScreenUpdating = True
    
    Set Rs = Nothing
    Set Con = Nothing
End Sub
 
İlgilenen üstadlarıma teşekkür ederim.

Sayın Haluk Bey'in önerisiyle listview yerine listbox kullanmaya karar verdim ve gösterdiği yolla dosyada bayağı ilerleme kaydettim. Görsel ve işlevsel olarak iyi bir yere getirdim.

Sayın Korhan Ayhan'ın önerisi maalesef resimdeki hatayı verdi:

217671
217672


Ben listview'i başlıklar da var diye düşünmüştüm ama kullanmayı beceremedim maalesef. Listboxla devam edeceğim.

Dosyanın son halini paylaşıyorum. Bu aşamadan sonra kalan işler yazdırma ve baskı önizleme işlemleri için kod yazmak. Yarın fırsat bulursam o konuyla ilgileneceğim.
 

Ekli dosyalar

  • 1588974119330.png
    1588974119330.png
    11.5 KB · Görüntüleme: 5
  • Muhtar Bordro.xlsm
    Muhtar Bordro.xlsm
    1,010.2 KB · Görüntüleme: 4
Ben son eklediğiniz dosyadaki verilere uyguladığımda bir hata almadım.
 

Ekli dosyalar

YUSUF44' Alıntı:
İlgilenen üstadlarıma teşekkür ederim.

Sayın Haluk Bey'in önerisiyle listview yerine listbox kullanmaya karar verdim ve gösterdiği yolla dosyada bayağı ilerleme kaydettim. Görsel ve işlevsel olarak iyi bir yere getirdim.

Sayın Korhan Ayhan'ın önerisi maalesef resimdeki hatayı verdi:

Ekli dosyayı görüntüle 217671
Ekli dosyayı görüntüle 217672


Ben listview'i başlıklar da var diye düşünmüştüm ama kullanmayı beceremedim maalesef. Listboxla devam edeceğim.

Dosyanın son halini paylaşıyorum. Bu aşamadan sonra kalan işler yazdırma ve baskı önizleme işlemleri için kod yazmak. Yarın fırsat bulursam o konuyla ilgileneceğim.
Genişletmek için tıkla ...
Hayırlı geceler. Sayın yusuf bey ve konu ile ilgilenen diğer hocalarımız emeğinize sağlık. Çok emek veryorsunuz hakkınızı helal edin.
 
Korhan Ayhan' Alıntı:
Ben son eklediğiniz dosyadaki verilere uyguladığımda bir hata almadım.
Genişletmek için tıkla ...

Sayın Korhan Ayhan, teşekkürler. Dosyanız bende de çalıştı.

Ben öncesinde dosyayı son haline getirmiştim. Ekte görebilirsiniz. Listbox3'e göre bir çok düzenleme yaptım. Verdiğiniz dosyaya göre listbox3 ile yaptıklarımı listview ile yapmaya çalıştım ama listview kodlarının listbox kodlarıyla pek alakası olmadığından bir türlü işle hale getiremedim. Dosya zaten şu anda gayet güzel bir şekilde çalıştığı için düzeni bozmak istemedim. Ancak örnek dosyanız elimde olacak, ilerde üzerinde çalışarak kendimi geliştirmeme faydası olacak.

@sedat2161 ekli dosyayı inceleyiniz, istediğiniz gibi olmuş mu?
 

Ekli dosyalar

@YUSUF44,

Elinize sağlık...

Elbette hazırladığınız düzeni bozmayın. Ben sadece çalışır olduğunu göstermek ve faydalanmak isteyen olabilir düşüncesiyle dosyayı paylaştım.

Harici nesneler her zaman cezbedici olmuştur. Fakat kullandığınızda birçok sıkıntılar (32 Bit/64 Bit durumundan dolayı) çıkardığı için bende tercih etmiyorum.
 
YUSUF44' Alıntı:
Sayın Korhan Ayhan, teşekkürler. Dosyanız bende de çalıştı.

Ben öncesinde dosyayı son haline getirmiştim. Ekte görebilirsiniz. Listbox3'e göre bir çok düzenleme yaptım. Verdiğiniz dosyaya göre listbox3 ile yaptıklarımı listview ile yapmaya çalıştım ama listview kodlarının listbox kodlarıyla pek alakası olmadığından bir türlü işle hale getiremedim. Dosya zaten şu anda gayet güzel bir şekilde çalıştığı için düzeni bozmak istemedim. Ancak örnek dosyanız elimde olacak, ilerde üzerinde çalışarak kendimi geliştirmeme faydası olacak.

@sedat2161 ekli dosyayı inceleyiniz, istediğiniz gibi olmuş mu?
Genişletmek için tıkla ...
Yusuf hocam emeğinize sağlık. ALLAH razı olsun evde bilgisayar yok pazartesi işyerime geçtiğimde dosyayı kontrol eder tekrar size dönüş yaparım. Zamanını bize ayıran tüm hocalarımıza teşekkürlerimi sunarım. İyi çalışmalar diliyorum.
 
sedat2161' Alıntı:
Yusuf hocam emeğinize sağlık. ALLAH razı olsun evde bilgisayar yok pazartesi işyerime geçtiğimde dosyayı kontrol eder tekrar size dönüş yaparım. Zamanını bize ayıran tüm hocalarımıza teşekkürlerimi sunarım. İyi çalışmalar diliyorum.
Genişletmek için tıkla ...
Yusuf bey ilginiz için çok teşekkür ederim. Köye gittiğimden dolayı bilgisayar yoktu internette çok ağır çalışıyordu cevap yazamadım. Çok emek vermişsiniz isteğimden çok iyi olmuş ALLAH razı olsun hayırlı günler diliyorum
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst