Bul aktar ve yazdır

sedat2161 · 8 Mayıs 2020

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.

YUSUF44 · 8 Mayıs 2020

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

Erdem Akdemir · 8 Mayıs 2020

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"""

sedat2161 · 8 Mayıs 2020

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

Hocam ilginiz için çok teşekkür ederim

YUSUF44 · 8 Mayıs 2020

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"""

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.

YUSUF44 · 8 Mayıs 2020

@Korhan Ayhan @dalgalikur @halit3 @Haluk üstadlarım: #2 nolu mesajımdaki dosyada Listview ve listbox'a sorgu sonucunun listelenmesi için ne yapmamız gerekir?

Haluk · 8 Mayıs 2020

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.

.

Korhan Ayhan · 8 Mayıs 2020

@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

YUSUF44 · 9 Mayıs 2020

İ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:

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.

Korhan Ayhan · 9 Mayıs 2020

Ben son eklediğiniz dosyadaki verilere uyguladığımda bir hata almadım.

sedat2161 · 9 Mayıs 2020

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.

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.

YUSUF44 · 9 Mayıs 2020

Korhan Ayhan' Alıntı:
Ben son eklediğiniz dosyadaki verilere uyguladığımda bir hata almadım.

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?

Korhan Ayhan · 9 Mayıs 2020

@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.

sedat2161 · 9 Mayıs 2020

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?

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 · 21 Mayıs 2020

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.

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

Bul aktar ve yazdır

sedat2161

Ekli dosyalar

YUSUF44

Destek Ekibi

Ekli dosyalar

Erdem Akdemir

Destek Ekibi

sedat2161

YUSUF44

Destek Ekibi

YUSUF44

Destek Ekibi

Haluk

Özel Üye

Korhan Ayhan

Administrator

YUSUF44

Destek Ekibi

Ekli dosyalar

Korhan Ayhan

Administrator

Ekli dosyalar

sedat2161

YUSUF44

Destek Ekibi

Ekli dosyalar

Korhan Ayhan

Administrator

sedat2161

sedat2161