Sayfalar arası rapor alma

[acebeci]

değerli hocalarım sorumun detayını ekteki dosyada gönderdim yardımcı olabilirseniz çok sevinirim.teşekkürler

 

[Mahmut Kök]

ekli dosyadaki örneğe bakınız.

 

[acebeci]

hocam çok özür dilerim ama devamlı hata veriyor nasıl çalıştıracağım.cahilliğime bağışlayın bulamadım

 

[acebeci]

arkadaşlar bu çalışma benim için gerçekten çok önemli lütfen bir bakın

 

[Mahmut Kök]

Sizde DTPicker bulunmayabilir. Onu kaldırdım.Bu şekilde deneyiniz. Eğer yine hata verirse, hatayı da belirtiniz.

 

[acebeci]

Private Sub UserForm_initialize() 'normalde sarı oluyorda gözükmediği için kırmızı yazdım
UserForm3.ListView1.View = lvwReport
UserForm3.ListView1.FullRowSelect = True
UserForm3.ListView1.ColumnHeaders.Clear


UserForm3.ListView1.ColumnHeaders.Add , , "İŞLEM SAYFASI"
For a = 2 To 16
UserForm3.ListView1.ColumnHeaders.Add , , Sheets(5).Cells(3, a)
Next

End Sub


ayrıca burada da hata veriyor hocam
tarih = CDate(UserForm3.DTPicker1) burda

 

[Mahmut Kök]

Göster düğmesinin yanındaki kutucuğa tarih giriyor musunuz? Oraya mesela

08.08.2007 girip deneyiniz. Bende sorunsuz çalışıyor.

 

[acebeci]

hocam çok özüe dilerim sizi baya yordum o kısma tarih girdiğim zaman aşağıda ki hatayı veriyor ben kırmızı ile yazdım o kısmı

Private Sub CommandButton1_Click()

UserForm3.ListView1.ListItems.Clear

tarih = CDate(UserForm3.DTPicker1)
x = 1
For s = 5 To Worksheets.Count

 

[Mahmut Kök]

Sayın acebeci, liselemeyi formdan alıp, sayfaya aktaracağım. Anladğım kadarıyla sizin programınızda bazı denetimler desteklenmiyor. Kodları uyarlayıp, buraya ekleyeceğim inşallah.

 

[Mahmut Kök]

ekli dosyaya bakınız, inşallah sorunsuz çalışır.

Tarih sütunu, sayı şeklinde kalmış, onu hücreleri biçimlendirden tarih şekline getirmeniz gerekir.

 

[acebeci]

sayın arkadasım mesleki vermiş olduğun gayret göstermiş olduğun sabır için sana gerçekten teşekkür ederim.Problemi birtürlü çözemedim eğer bildiğin başka bir yol varsa yada bilen arkadaşlar varsa lütfen yardımcı olurmusunuz bu konu benim için gerçekten çok önemli.Şimdiden hepinize teşekkür ediyorum

 

[acebeci]

arkadaşlar dosyayı tekrar ekliyorum lütfen birdaha ilgilenebilirmisiniz.bu konuda beni yanlız bırakmazsanız sevinirim.şimdiden kolay gelsin

 

[Mahmut Kök]

Sayın acebeci, tarihe göre rapor alma işlemi için hazırlamış olduğum kodlar bende çalışıyor. İşin açığı, diğer arkadaşların bilgisayarlarında benim eklediğim örnek çalışmalar çalışacak mı ben de merak ediyorum.

Aklıma gelen bir husus da; siz excel 2007 kullanıyorsunuz. Bende ise 2003 var. Bundan dolayı uyuşmayan kodlar olabilir gibime geldi. Eğer mümkünse, excel xp veya 2003 mevcutsa, bir de onlarda deneyiniz.

Forumdaki arkadaşlarımız ilgileneceklerdir. Herkese iyi çalışamlar.

 

[acebeci]

sayın mesleki göstermiş olduğunuz ilgiden dolayı çok teşekkür ediyorum.sorun galiba sizin de belirttiğiniz gibi benim ofıs 2007 kullanmam.yakınlarımda hiç ofıs2003 yok o yüzden deneme şansım pek yok.sizinde belirttiğiniz gibi umarım ve şiddetle arzularım ki diğer arkadaşlarda müsait olurlarsa bir göz atsınlar

 

[acebeci]

sayın mesleki göstermiş olduğunuz ilgiden dolayı çok teşekkür ediyorum.sorun galiba sizin de belirttiğiniz gibi benim ofıs 2007 kullanmam.yakınlarımda hiç ofıs2003 yok o yüzden deneme şansım pek yok.sizinde belirttiğiniz gibi umarım ve şiddetle arzularım ki diğer arkadaşlarda müsait olurlarsa bir göz atsınlar

..............

 

[acebeci]

arkadaşlar affınıza sığınarak birşey sormak istiyorum benim bu sorduğum sorunun excel de çözümümü yok yoksa ilgelenecek müsait bir arkadaşmı yok.bari sadece şunu söyleseniz bu sorunun çözümü yok yada biraz beklemeniz gerikiyor gibi.sakın yanlış anlamayın sitem olarak demiyorum sadece bilmediğimden soruyorum.şimdiden hepinizin affına sığınarak kolay gelsin dileklerimi iletiyorum

 

[acebeci]

.......................................

 

[Ferhat Pazarçevirdi]

Sn.Acebeci,

Aslında Sn.Mesleki'nin hazırladığı kodlar, bende düzgün çalışıyordu. Muhtemelen sizde bazı componentler yüklenmediği için hatalar almaktasınız.

Ekteki dosyayı ayrıca yüklenen herhangi bir component olmadan hazırladım. Büyük bir ihtimalle sizde çalışması lazım. Verileri Excel'e dökmedim. Nasıl bir rapor istiyorsanız, ona göre bir dizayn yapın ve daha sonra listbox'takileri sayfaya aktaralım.

Not : Dosyanıza ekteki Userform ve Kodlar ilave edildi.

Private Sub CommandButton1_Click() 'Sorgula
Dim HaricSayfalar() As Variant
HaricSayfalar = Array("RAPOR", "Giriş", "Liste", "Şablon")
ListBox1.Clear
If IsDate(ComboBox1) = False And ComboBox1.Text <> "T&#252;m&#252;" Then
   MsgBox "Tarih giri&#351;inde bir hata var. L&#252;tfen kontrol edip, d&#252;zeltiniz", vbCritical, "UYARI"
   Exit Sub
End If
If ComboBox1.Text <> "T&#252;m&#252;" Then tarih = CDate(ComboBox1)
For Each sh In ThisWorkbook.Sheets
    For i = 0 To UBound(HaricSayfalar) - 1
        If HaricSayfalar(i) = sh.Name Then x = x + 1
    Next i
    If x = 0 Then
       For i = 4 To sh.Cells(65536, 3).End(xlUp).Row
           If sh.Cells(i, 2) = tarih Or ComboBox1 = "T&#252;m&#252;" Then
              If sh.Cells(i, 3) = ComboBox2 Or ComboBox2 = "T&#252;m&#252;" Then
                 If sh.Cells(i, 4) = ComboBox3 Or ComboBox3 = "T&#252;m&#252;" Then
                    If sh.Cells(i, 5) = ComboBox4 Or ComboBox4 = "T&#252;m&#252;" Then
                       With ListBox1
                            .AddItem Format(sh.Cells(i, 2), "dd.mm.yyyy")
                            For j = 1 To 22
                                .List(ListBox1.ListCount - 1, j) = sh.Cells(i, j + 2)
                            Next j
                       End With
                    End If
                 End If
              End If
           End If
       Next i
    End If
    x = 0
Next
End Sub
[COLOR=green]'----------------------------------------------------------[/COLOR]
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub CommandButton3_Click()
With Sheets("Rapor")
    .Cells(2, 1) = "SORGU -> Tarih:" & ComboBox1 _
                 & ", Tarla Sahibi:" & ComboBox2 _
                 & ", Kime Gitti&#287;i:" & ComboBox3 _
                        & ", Plaka:" & ComboBox4
    .Range("A4:X10000").ClearContents
    .Cells(4, 2).Resize(ListBox1.ListCount, 23) = ListBox1.List
     For i = 4 To .Cells(65536, 2).End(xlUp).Row
         y = y + 1
         .Cells(i, 1) = y
     Next i
End With
End Sub
[COLOR=green]'------------------------------------------------------------[/COLOR]
Private Sub UserForm_Initialize()
Dim HaricSayfalar() As Variant
Dim sh As Object
Dim arrTarlaS() As Variant, arrKime() As Variant, arrPlaka() As Variant
Dim arrVeri() As Variant
Dim colTarlaS As New Collection, colKime As New Collection, colPlaka As New Collection
Dim Toplam As Long, y As Long
HaricSayfalar = Array("RAPOR", "Giri&#351;", "Liste", "&#350;ablon")
For Each sh In ThisWorkbook.Sheets
    For i = 0 To UBound(HaricSayfalar) - 1
        If HaricSayfalar(i) = sh.Name Then x = x + 1
    Next i
    If x = 0 Then: Toplam = Toplam + (sh.Cells(65536, 3).End(xlUp).Row - 3)
    x = 0
Next
ReDim arrTarlaS(Toplam)
ReDim arrKime(Toplam)
ReDim arrPlaka(Toplam)
 
For Each sh In ThisWorkbook.Sheets
    For i = 0 To UBound(HaricSayfalar) - 1
        If HaricSayfalar(i) = sh.Name Then x = x + 1
    Next i
    If x = 0 Then
       For i = 4 To sh.Cells(65536, 3).End(xlUp).Row
           arrTarlaS(y) = sh.Cells(i, 3).Value
           arrKime(y) = sh.Cells(i, 4).Value
           arrPlaka(y) = sh.Cells(i, 5).Value
           y = y + 1
       Next i
    End If
    x = 0
Next
colTarlaS.Add "T&#252;m&#252;", "T&#252;m&#252;": colTarlaS.Add arrTarlaS(0), arrTarlaS(0)
colKime.Add "T&#252;m&#252;", "T&#252;m&#252;": colKime.Add arrKime(0), arrKime(0)
colPlaka.Add "T&#252;m&#252;", "T&#252;m&#252;": colPlaka.Add arrPlaka(0), arrPlaka(0)
For i = 0 To UBound(arrTarlaS) - 1
 
    For Each Eleman1 In colTarlaS
        If Eleman1 = arrTarlaS(i) Then: x = x + 1
    Next
    If x = 0 Then colTarlaS.Add arrTarlaS(i), arrTarlaS(i)
    x = 0
 
    For Each Eleman2 In colKime
        If Eleman2 = arrKime(i) Then: y = y + 1
    Next
    If y = 0 Then colKime.Add arrKime(i), arrKime(i)
    y = 0
    For Each Eleman3 In colPlaka
        If Eleman3 = arrPlaka(i) Then: z = z + 1
    Next
    If z = 0 Then colPlaka.Add arrPlaka(i), arrPlaka(i)
    z = 0
Next
ComboBox1.AddItem "T&#252;m&#252;": ComboBox1.ListIndex = 0
For Each Eleman In colTarlaS: ComboBox2.AddItem Eleman: Next: ComboBox2.ListIndex = 0
For Each Eleman In colKime: ComboBox3.AddItem Eleman: Next: ComboBox3.ListIndex = 0
For Each Eleman In colPlaka: ComboBox4.AddItem Eleman: Next: ComboBox4.ListIndex = 0
With ListBox1
     .Clear
     .ColumnCount = 4
     .ColumnWidths = "100;135;112;100"
End With
ReDim arrVeri(1 To Toplam, 1 To 23)
For Each sh In ThisWorkbook.Sheets
    For i = 0 To UBound(HaricSayfalar) - 1
        If HaricSayfalar(i) = sh.Name Then x = x + 1
    Next i
    If x = 0 Then
       For i = 4 To sh.Cells(65536, 3).End(xlUp).Row
           a = a + 1
           arrVeri(a, 1) = Format(sh.Cells(i, 2), "dd.mm.yyyy")
           For j = 2 To 23
               arrVeri(a, j) = sh.Cells(i, j + 1)
           Next j
       Next i
    End If
    x = 0
Next
ListBox1.List = arrVeri
CommandButton2.Cancel = True
End Sub

 

[acebeci]

Teşekkür

Sayın fpc inanın siz tam bir harikasınız size nasıl teşekkür etsem bilemiyorum gerçekten teşekkür ederim.yazmış olduğunuz kod şuan ihtiyacıma tam cevap veriyor yalnız şöyle birşey var bunun rapor sonuçlarını yazıcıdan çıktısını almam mümkünmü tabi eger mümkünse sizide artık fazla meşgul etmek istemiyorum.eğer müsait bir zamanınız olurda bakabilirseniz sevinirim.Bakamazsanız bile vermiş olduğugunuz emeğe göstermiş olduğunuz sabıra çok ama çok teşekkür ederim.Allah zihin açıklığı versin.

 

[Ferhat Pazarçevirdi]

Rica ederim.

18 Nolu mesajdaki dosyayı revize ettim. İnceleyiniz.