Dtpicker ile kayıtları çağırmak?

[Evren Gizlen]

Dosyaı email adresinize yoladım.Siz oldu dedikten sonra kodları buradan yayınlayabiliriz.
Yalnız şimdi şöyle bir durum ortaya çıktı.Dtpicker1 için yazdığınzı kodlara ve dtpicker1 e gerek kalmadı.İsteyen bu dtpicker2 ve dtpicker3 teki taihin aynisini seçerek sadece 1 dosya listeleyebilirler.
Not:Başlangıç bir sefer girmek gerekiyor.Kodları ona göre yazdım.
Eğer her dosyada ilk başlangıç yazılacaksa ve öyle istiyorsanız kodu ona gör edüzenleyebilirim.

[winpa]

Değerli Evren Bey;

Kodlar istediğim gibi olmuş. Kodlarda herhangi bir değişikliğe gereksinim yok.
Dtpicker1'e gerek kalmadı evet.
Fakat ben optionbutton kullanarak Dtpicker2 ve Dtpicker3 deactive yapacağım isteğe göre tarih aralığında veri görüntülenmek istendiğinde optionbutton basarak active edebilecek diye düşünüyorum.

Sizin emeğiniz olduğundan kodu sizin yayınlamanız. Daha uygun olacağını düşünüyorum.

Emeğinize, ellerinize sağlık.
Yardımlarınızdan dolayı çok teşekkür ederim.

Saygılarımla.

[winpa]

Evren Bey;

Konu ile ilgili birşey daha sormak istiyorum.

2003 Türkçe versiyonunda kodda hata vermiyor.
Fakat ingilizce versiyonda
tarih = Format(Me.DTPicker1, "dd.mm.yyyy") type mismatch hatası vermektedir.

Bununla ilgili bir fikriniz var mı?

Saygılarımla.

[Evren Gizlen]

winpa Nickli Üyeden Alıntı

Evren Bey;

Konu ile ilgili birşey daha sormak istiyorum.

2003 Türkçe versiyonunda kodda hata vermiyor.
Fakat ingilizce versiyonda
tarih = Format(Me.DTPicker1, "dd.mm.yyyy") type mismatch hatası vermektedir.

Bununla ilgili bir fikriniz var mı?

Saygılarımla.

Tarih değişkenini dim tarih as date diye prosedürün hemen başlangıcında tanıtıp deneyiniz.Tanıtılmadığı için olabilir.

[winpa]

Evren Bey;

Dim tarih As Date, var As Boolean, z As Object, myarr(), tpl As Double, tp2 As Double

olarak prosedür gözükmekte. Hata verdikten sonra Dim tarih As Date kırmızı renkle işaretlediğim tarih yazısının üzerine gelince tarih=12:00:00 AM olarak açıklma çıkmaktadır.?
Bölgesel dil sorunuyla ilgili olabilir mi?

Saygılarımla

[Evren Gizlen]

Arkadaşlar ilgilenenler için kodları aşğıda veriyorum.

 
Dim conn As ADODB.Connection, rs As ADODB.Recordset, ds As Object
Dim dosya As String, yol As String, x As Long, fso As Object, fs As Object
Dim tarih As Date, var As Boolean, z As Object, myarr(), tpl As Double, tp2 As Double
yol = ThisWorkbook.Path & "\STOK"
tarih = Format(Me.DTPicker1, "dd.mm.yyyy")
Me.Spreadsheet1.Sheets(1).Select
Me.Spreadsheet1.Sheets(1).Range("A1:M262144").Clear
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set fso = CreateObject("Scripting.FileSystemObject")
Set fs = fso.getfolder(yol).Files
Set z = CreateObject("Scripting.Dictionary")
ReDim myarr(1 To 12, 1 To 262143)
For Each ds In fs
    If UCase(Right(ds.Name, 4)) = ".XLS" Then
        dosya = Left(ds.Name, Len(ds.Name) - 4)
        If IsDate(dosya) Then
            If CDate(dosya) >= DTPicker2.Value And CDate(dosya) <= DTPicker3.Value Then
                dosya = ds.Name
                conn.Open "provider=microsoft.jet.oledb.4.0;data source=" & yol & "\" & dosya _
                & ";extended properties=""excel 8.0;hdr=yes;"""
                rs.Open "select * from [STOK$B1:M65536];", conn, adOpenKeyset, adLockReadOnly
                For n = 0 To rs.Fields.Count - 1
                    Me.Spreadsheet1.ActiveSheet.Cells(1, n + 1) = rs.Fields(n).Name
                Next
                If rs.RecordCount > 0 Then
                    rs.MoveFirst
                    Do While Not rs.EOF
                        If rs(0).Value <> "" Then
                            If Not z.exists(rs(0).Value) Then
                                x = x + 1
                                z.Add rs(0).Value, x
                                For k = 1 To 4
                                    myarr(k, x) = rs(k - 1).Value
                                Next
                            End If
                                For k = 6 To 8
                                    If Not IsNull(rs(k - 1).Value) Then tpl = rs(k - 1).Value
                                    myarr(k, z.Item(rs(0).Value)) = myarr(k, z.Item(rs(0).Value)) + tpl
                                    tpl = 0
                                Next
                                If Not IsNull(rs(5).Value) Then tpl = rs(5).Value
                                If Not IsNull(rs(4).Value) Then tpl2 = rs(4).Value
                                myarr(5, z.Item(rs(0).Value)) = myarr(5, z.Item(rs(0).Value)) + tpl2 + tpl
                                tpl = 0
                                tpl2 = 0
                                myarr(9, z.Item(rs(0).Value)) = myarr(5, z.Item(rs(0).Value)) - myarr(8, z.Item(rs(0).Value))
                                myarr(10, z.Item(rs(0).Value)) = myarr(7, z.Item(rs(0).Value)) - myarr(9, z.Item(rs(0).Value))
                                myarr(11, z.Item(rs(0).Value)) = (myarr(3, x) * myarr(9, z.Item(rs(0).Value))) + _
                                (myarr(3, x) * myarr(10, z.Item(rs(0).Value)))
                                myarr(12, z.Item(rs(0).Value)) = myarr(11, z.Item(rs(0).Value)) * myarr(4, x)
                                var = True
                        End If
                        rs.MoveNext
                    Loop
                End If
                rs.Close: conn.Close
            End If
        End If
    End If
Next
Set rs = Nothing: Set conn = Nothing
If var = True And x > 0 Then
    ReDim Preserve myarr(1 To 12, 1 To x)
    Me.Spreadsheet1.ActiveSheet.Range("A2:L" & x + 1) = WorksheetFunction.Transpose(myarr)
    Spreadsheet1.ActiveWindow.ViewableRange = "a1:L" & x + 1
    MsgBox "Veriler Akatarildi." & vbLf & _
    "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
    Else
    MsgBox "Aktarılacak tarihe uyan dosya bulunamdı.Aktarma Yapılmadı.", vbCritical, "UYARI"
End If

[Evren Gizlen]

winpa Nickli Üyeden Alıntı

Evren Bey;

Dim tarih As Date, var As Boolean, z As Object, myarr(), tpl As Double, tp2 As Double

olarak prosedür gözükmekte. Hata verdikten sonra Dim tarih As Date kırmızı renkle işaretlediğim tarih yazısının üzerine gelince tarih=12:00:00 AM olarak açıklma çıkmaktadır.?
Bölgesel dil sorunuyla ilgili olabilir mi?

Saygılarımla

VBE'de Dtpickeri seçip Propertiesten kostüm özelliğne geliniz .Oradaki format seçeneğini kontrol ediniz short date ayarlı olması lazım.Time seçili sizde tahminimce.

[winpa]

Evren Bey;

Sorunu buldum. Bölgesel ayarlardan "/" "." nokta olarak değiştirdim. Problem çözüldü.

Saygılarımla.