Skip to main content

AccessTr.neT


Excele göndermede datayı okumuyor

bibib
bibib
2
1790

Excele göndermede datayı okumuyor

#1
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]));
Son Düzenleme: 01/11/2015, 17:56, Düzenleyen: bibib.
Cevapla
#2
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
Cevapla
#3
Bu şekilde yardım almanız zor olur. Örnek dosya halinde eklerseniz yardımcı olmak mümkün olur.
AccessTr.Net teknik konular içeren bir sitedir. Bu tip sitelerde en iyi şekilde yardım alabilmeniz için Site Kurallarını mutlaka okumanız ve buna göre hareket etmeniz lazım.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da