AccessTr.neT

Arkadaşlar merhaba

Yaptığım programda yine bir arkadaşımızın hazırlamış olduğu kodları kendi programıma uyguladım fakat excel'e aktarmaya başladığı zaman dataları taşımıyor başlıkları yazdıktan sonra sonsuz döngü oluşturarak sadece sıra numarasını ekliyor (dataları bulamıyor) yardımcı olursanız sevinirim

-------------------------------------------------------



On Error Resume Next

Dim rs As Recordset

Dim KTP As Workbook

Dim SYF As Worksheet

Dim i%

Dim ORTALA

Dim Xi

Dim SATIR As String

Dim SÜTUN As String

Dim durum_say

Dim Sonuç_say









Evrk_Rpr = 3

Snç_Rpr = 3









Set Excl = New Excel.Application

    

    With Excl

        .Application.Visible = True

        .UserControl = True









    End With

    

    Set KTP = Excl.Workbooks.Add

    Set SYF = KTP.Worksheets(1)

      

'BAŞLIKLAR DÜZENLENİYOR

With Excl

















On Error Resume Next

        .Cells.Font.Name = "Calibri" 'Excel sayfasının yazı tipi

        .Cells.Font.Size = 10 'Excel sayfasındaki yazıların boyutu

End With

'********************************************

SYF.Cells(3, 1) = "S.N." 'A SÜTUN

SYF.Cells(3, 1).Font.ColorIndex = 255

SYF.Cells(3, 2) = "EVRAKIN GELDİĞİ YER" 'B SÜTUN' buraya eşittirden sonra form üzerindeki metin kutusundanda başlık alabiliriz. ( Me.Metin0) gibi..

SYF.Cells(3, 3) = "GEL.ŞEKLİ" 'C SÜTUN

SYF.Cells(3, 4) = "E.G.TARİHİ" 'D SÜTUN

SYF.Cells(3, 5) = "E.SAYISI" 'E SÜTUN

SYF.Cells(3, 6) = "ALN.TARİH" 'F SÜTUN

SYF.Cells(3, 7) = "SAYISI" 'G SÜTUN

SYF.Cells(3, 8) = "EKİ" 'H SÜTUN

SYF.Cells(3, 9) = "KONUNUN ÖZETİ" 'I SÜTUN

SYF.Cells(3, 10) = "DURUMU" 'J SÜTUN

SYF.Cells(3, 11) = "BEKLETEN KİŞİ" 'K SÜTUN

SYF.Cells(3, 12) = "GÖNDERİLDİĞİ KISIM" 'L SÜTUN

SYF.Cells(3, 13) = "G.TARİHİ" 'M SÜTUN

SYF.Cells(3, 14) = "SONUÇLANDI" 'N SÜTUN

SYF.Cells(3, 15) = "GÖNDERİLDİĞİ YER" 'O SÜTUN

SYF.Cells(3, 16) = "GND.ŞEK." 'P SÜTUN

SYF.Cells(3, 17) = "S.TARİHİ" 'Q SÜTUN

SYF.Cells(3, 18) = "S.SAYISI" 'R SÜTUN

SYF.Cells(3, 19) = "YAPILAN İŞLEMİN ÖZETİ" 'S SÜTUN

SYF.Cells(3, 20) = "DOSYASI" 'T SÜTUN









SYF.Range("A3:T3").HorizontalAlignment = xlCenter 'Hücre veriye göre ortalanıyor (BAŞLIKLAR)

SYF.Range("A3:T3").Font.Bold = True 'Hücre veriye kalın harle yazıyor (BAŞLIKLAR)









'********************************************

'BAŞLIK DÜZENLEME İŞLEMİ SONLANDIRILIYOR

'******************************************************************************************

Set rs = CurrentDb.OpenRecordset("Tüm_kayıt_excel")' BUSORGUYA BAĞLANIP VERİLERİ OKUMUYOR

    i = 4 '4 inci satırdan YAZDIRMAYA BAŞLIYOR başla (3.SATIR BAŞLIKLAR)

durum_say = 0: Sonuç_say = 0









    Do Until rs.EOF

    SATIR = "A" & i: SÜTUN = "T" & i

 'yazılacak satırın ayarları yapılıyor

        SYF.Cells(i, "A") = i - 3 'Sıra numarası veriliyor

        SYF.Cells(i, "A").HorizontalAlignment = xlCenter 'Hücre veriye göre ortalanıyor

        SYF.Cells(i, "B") = rs(1)

        SYF.Cells(i, "C") = rs(2)

        SYF.Cells(i, "C").HorizontalAlignment = xlCenter 'Hücre veriye göre ortalanıyor

        SYF.Cells(i, "D") = rs(3) 'Hücreye dosyadaki değer yazdırılıyor

        SYF.Cells(i, "D").NumberFormat = "mm.dd.yyyy" 'Hücre tarih formatına ayrlarnıyor

        SYF.Cells(i, "D").HorizontalAlignment = xlCenter 'Hücre veriye göre ortalanıyor

        SYF.Cells(i, "E") = rs(4)

        SYF.Cells(i, "F") = rs(5) 'Hücreye dosyadaki değer yazdırılıyor

        SYF.Cells(i, "F").NumberFormat = "mm.dd.yyyy" 'Hücre tarih formatına ayrlarnıyor

        SYF.Cells(i, "F").HorizontalAlignment = xlCenter 'Hücre veriye göre ortalanıyor

        SYF.Cells(i, "G") = rs(0) 'Hücreye dosyadaki değer yazdırılıyor

        SYF.Cells(i, "G").HorizontalAlignment = xlCenter 'Hücre veriye göre ortalanıyor (evrak numarası)

        SYF.Cells(i, "H") = rs(6)

        SYF.Cells(i, "I") = rs(7) 'Hücreye dosyadaki değer yazdırılıyor

        If rs(8) = "Beklemede" Then SYF.Cells(i, "J") = rs(8): SYF.Range(SATIR, SÜTUN).Font.Color = vbRed: durum_say = durum_say + 1

        If rs(8) = "Gönderildi" Then SYF.Cells(i, "J") = rs(8):

        SYF.Cells(i, "K") = rs(9)

        SYF.Cells(i, "L") = rs(10)

        SYF.Cells(i, "M") = rs(11)

        SYF.Cells(i, "M").NumberFormat = "mm.dd.yyyy"

        If rs(12) = -1 Then SYF.Cells(i, "N") = "Sonuçlandı":

        If rs(12) = 0 Then SYF.Cells(i, "N") = "Sonuçlanmadı": SYF.Range(SATIR, SÜTUN).Font.Color = vbBlue: Sonuç_say = Sonuç_say + 1

        SYF.Cells(i, "O") = rs(13)

        SYF.Cells(i, "P") = rs(14)

        SYF.Cells(i, "P").HorizontalAlignment = xlCenter 'Hücre veriye göre ortalanıyor

        SYF.Cells(i, "Q") = rs(15) 'Hücreye dosyadaki değer yazdırılıyor

        SYF.Cells(i, "Q").NumberFormat = "mm.dd.yyyy" 'Hücre tarih formatına ayrlarnıyor

        SYF.Cells(i, "Q").HorizontalAlignment = xlCenter 'Hücre veriye göre ortalanıyor

        SYF.Cells(i, "R") = rs(16)

        SYF.Cells(i, "R").HorizontalAlignment = xlLeft 'Hücre veriye sola yaslanıyor

        SYF.Cells(i, "S") = rs(17)

        SYF.Cells(i, "T") = rs(18)

       

    i = i + 1

        rs.MoveNext

            Loop

            rs.Close

'******************************************************************************************

'Hücrelere tablo çizdiriyoruz...

 SATIR = "": SÜTUN = ""

For Xi = 3 To i - 1

    SATIR = "A" & Xi

    SÜTUN = "T" & Xi

    SYF.Range(SATIR, SÜTUN).Borders.LineStyle = xlContinuous ' hücre çerçeve içine alınıyor tablo çiziliyor

    SYF.Range(SATIR, SÜTUN).EntireColumn.AutoFit 'Hücre veriye göre genişletiliyor

 Next

 'Tablo çizim işlemi tamamlandı

'**********************************************************************************************************************************************************

'liste Raporu yazdırılıyor

     SYF.Cells(2, "A") = "Bekletilen Evrak Sayısı : " & durum_say

     SYF.Cells(2, "A").Font.Color = vbRed 'FONT RENGİ KIRMIZI YAPILIYOR

     SYF.Cells(2, "A").Font.Size = 12 'Excel sayfasındaki yazıların boyutu

     SYF.Range("A2:B2").MergeCells = True 'SÜTUNLAR BİRLEŞTİRİLİYOR

     SYF.Range("A2:B2").Font.Bold = True 'YAZILAR KALINLAŞTIRILIYOR

 '  'liste Raporu yazdırılıyor

     SYF.Cells(2, "C") = "Sonuçlandırılmayan Evrak Sayısı : " & Sonuç_say

     SYF.Cells(2, "C").Font.Color = vbBlue 'FONT RENGİ MAVİ YAPILIYOR

     SYF.Cells(2, "C").Font.Size = 12 'Excel sayfasındaki yazıların boyutu

     SYF.Range("C2:E2").MergeCells = True 'SÜTUNLAR BİRLEŞTİRİLİYOR

     SYF.Range("C2:E2").Font.Bold = True 'SÜTUNLAR BİRLEŞTİRİLİYOR

'******************************************************************************************

'liste Raporu BAŞLIK  yazdırılıyor

     SYF.Cells(1, "A") = "EVRAK KAYITLARIN LİSTESİ"

     SYF.Cells(1, "A").Font.Name = "Arial" 'Excel sayfasının yazı tipi

     SYF.Cells(1, "A").Font.Size = 20 'Excel sayfasındaki yazıların boyutu

     SYF.Cells(1, "A").Font.Color = vbRed 'FONT RENGİ KIRMIZI YAPILIYOR

     SYF.Range("A1:I1").MergeCells = True 'SÜTUNLAR BİRLEŞTİRİLİYOR

     SYF.Range("A1:I1").Font.Bold = True 'YAZILAR KALINLAŞTIRILIYOR

     SYF.Range("A1:I1").EntireColumn.AutoFit

'******************************************************************************************

    '  excelsayfaayari ' Sub excelsayfaayari() isimli prosedürü çağırıyoruz ve prosedürde yazan sayfa düzenleme işlemlerini yaptırıyoruz.









Set Excl = Nothing

'*************************************** İŞLEM BİTTİ ***********************************************************

----------------------------------------------------------------------------------

kullandığım referanslar

* Visual Basic For Aplications
* Micrasoft Access 15.0 object Library
* OLE Autımation
* Micrasoft ActiveX Data Object Library
* Micrasoft Excel 15.0 Object Library

-----------------------------------------
Oluşturduğum Data Defter Kayıt
"DEFTER_KAYIT_FORMU"
Sogu (Formdan başlangıç ve bitiş tarihlerini alarak 2 Tarih arasındaki kayırları getiriyor)
"Tüm_kayıt_excel"
Sorgunun SQL'i : SELECT [DEFTER KAYIT].[KAYIT NO], [DEFTER KAYIT].[GELDİĞİ YER], [DEFTER KAYIT].GELİŞ_ŞEKLİ, [DEFTER KAYIT].TARİH, [DEFTER KAYIT].SAYISI, [DEFTER KAYIT].[ALINDIĞI TARİH], [DEFTER KAYIT].EKİ, [DEFTER KAYIT].[KONUNUN ÖZETİ], [DEFTER KAYIT].BEKLEME_DURUMU, [DEFTER KAYIT].BEKLEYEN_KİŞİ, [DEFTER KAYIT].[GÖNDERİLDİĞİ YER], [DEFTER KAYIT].TARİHİ, [DEFTER KAYIT].SNÇLND, [DEFTER KAYIT].SNÇ_GÖND_YER, [DEFTER KAYIT].SNÇ_TÜRÜ, [DEFTER KAYIT].SNÇ_TARİHİ, [DEFTER KAYIT].SNÇ_SAYISI, [DEFTER KAYIT].[KONUNUN YAPILAN VEYA YAPILACAK İŞLEMİN ÖZETİ], [DEFTER KAYIT].[AİT OLDUĞU DOSYA NO], [DEFTER KAYIT].[KAYIT NO SONRASI], [DEFTER KAYIT].[KAYIT NO ÖNCESİ]
FROM [DEFTER KAYIT]
WHERE ((([DEFTER KAYIT].TARİH) Between [Formlar]![DEFTER_KAYIT_FORMU]![Tarih_A] And [Formlar]![DEFTER_KAYIT_FORMU]![Tarih_B]));

arkadaşlar oluşturduğum sorguda herhangi bir sorgu kullanmadan okutarak direk aşağıdaki kod ile excele verileri gönderebiliyorum fakat sorguya form üzerinden ilk ve son tarih bilgilerini girdikten sonra beetwen kullanarak oluşturduğum zaman komutu çalıştırınca hata veriyor ve göndermiyor yardımcı olurmusunuz

kod Private Sub kmtexcel_Click()



Dim runxls As New Excel.Application

Dim dosya As Excel.Workbook

Dim sayfa As Excel.Worksheet

Dim rs As New ADODB.Recordset

















Set Excl = New Excel.Application

With Excl

.Application.Visible = True

.UserControl = True









End With

Set KTP = Excl.Workbooks.Add

Set SYF = KTP.Worksheets(1)









'BAŞLIKLAR DÜZENLENİYOR

With Excl

















'***********************************









'rs.Open "SELECT * FROM [DEFTER KAYIT];", CurrentProject.Connection, adOpenKeyset, adLockReadOnly

rs.Open "Tüm_kayıt_excel", CurrentProject.Connection, adOpenKeyset, adLockReadOnly









x = 8









Do While rs.EOF = False

With Excl

.Cells(x, 1) = rs(1).Value

.Cells(x, 2) = rs(2).Value

.Cells(x, 3) = rs(3).Value

.Cells(x, 4) = rs(4).Value

.Cells(x, 5) = rs(5).Value

.Cells(x, 6) = rs(6).Value

.Cells(x, 7) = rs(7).Value

.Cells(x, 8) = rs(8).Value

.Cells(x, 9) = rs(9).Value

.Cells(x, 10) = rs(10).Value

.Cells(x, 11) = rs(11).Value

.Cells(x, 12) = rs(12).Value

.Cells(x, 13) = rs(13).Value

.Cells(x, 14) = rs(14).Value

.Cells(x, 15) = rs(15).Value

.Cells(x, 16) = rs(16).Value

















End With

x = x + 1

rs.MoveNext

Loop

rs.Close









End With









End Sub

Sorfu yaptırmadan direk dataları
rs.Open "Tüm_kayıt_excel", CurrentProject.Connection, adOpenKeyset, adLockReadOnly
kodu ile Excele aktardım ama 2 tarih arasındaki kayıtları sorguda veya komutla kullanmayı yapamadım
yardımcı olursanız sevinirim

Bu şekilde yardım almanız zor olur. Örnek dosya halinde eklerseniz yardımcı olmak mümkün olur.

bibib

bibib

alpeki99