+- AccessTr.neT (https://accesstr.net)
+-- Forum: AccessTr.neT Genel (https://accesstr.net/forum-accesstr-net-genel.html)
+--- Forum: Çöp Kutusu (https://accesstr.net/forum-cop-kutusu.html)
+--- Konu Başlığı: Excele göndermede datayı okumuyor (/konu-excele-gondermede-datayi-okumuyor.html)
Excele göndermede datayı okumuyor - bibib - 01/11/2015
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]));
Cvp: Excele göndermede datayı okumuyor - bibib - 01/11/2015
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
Cvp: Excele göndermede datayı okumuyor - alpeki99 - 02/11/2015
Bu şekilde yardım almanız zor olur. Örnek dosya halinde eklerseniz yardımcı olmak mümkün olur.