AccessTr.neT

Sayfalar: 1 2 3

Sevgili hocalarımız, sevgili forum üyeleri...

Başlığı özellikle bu şekilde yazmak istedim çünkü benim yapmayı düşündüğüm seçimli veri gönderimi forumdaki diğer örneklerden biraz farklı. Ben sorumu açıklayayım, sizler icabında varolan örnekleri benim sorunuma nasıl uyarlayacağımı da anlatabilirsiniz.

Sorum şu: Access Tablomda varolan verileri alan bazında, istediğim alandaki değer değişiminde excele atarken ayrı sayfalar halinde atması.

Dahada açıklayıcı olsun: Diyelimki kişi bilgilerini tuttuğum bir veritabanım olsun. Ben bunları excele göndermek istiyorum ama her kişinin bilgisini excelde aynı dosyada ayrı ayrı sayfalara atmasını istiyorum ve o sayfaya ilgili kişinin ismini yazmasını istiyorum.

Dediğim gibi forumdaki ilgili örnekleri inceledim ama benim sorunumu karşılamadığını düşündüm. Eğer yanılıyorsam bilgilendirin lütfen.

Umarım yeterince açık anlatabilmişimdir.

Saygılarımla,
Kadir

Kod:
Option Compare Database

Public Sub CopyRs2Sheet(strsql As String, strWorkBook As String, Optional strWorkSheet As String, Optional strCellRef As String)

On Error GoTo ProcError

DoCmd.Hourglass True

Dim objXLApp As Object

Dim objXLWb As Object

Dim objXLSheet As Object

Dim rs As DAO.Recordset

Dim fld As DAO.Field

Dim I As Integer

Dim iSheets As Integer

Set rs = CurrentDb.OpenRecordset(strsql, dbOpenSnapshot)

Set objXLApp = CreateObject("Excel.Application")

iSheets = objXLApp.SheetsInNewWorkbook

objXLApp.SheetsInNewWorkbook = 1

Set objXLWb = objXLApp.Workbooks.Open(strWorkBook)

objXLApp.SheetsInNewWorkbook = iSheets

If strWorkSheet = "" Then

strWorkSheet = "Sheet1"

End If

If strCellRef = "" Then

strCellRef = "A1"

End If

Set objXLSheet = objXLWb.Worksheets(strWorkSheet)

objXLSheet.Range(strCellRef).CopyFromRecordset rs

objXLSheet.Columns.AutoFit

objXLWb.Save

objXLWb.Close

If Not rs Is Nothing Then rs.Close

Set rs = Nothing

Set objXLSheet = Nothing

Set objXLWb = Nothing

If Not objXLApp Is Nothing Then objXLApp.Quit

Set objXLApp = Nothing

DoCmd.Hourglass False

Exit Sub

ProcError:

Select Case Err

Case 9

objXLWb.Worksheets.Add

Set objXLSheet = objXLWb.ActiveSheet

objXLSheet.Name = strWorkSheet

Resume Next

Case 1004

objXLApp.Workbooks.Add

Set objXLWb = objXLApp.ActiveWorkbook

objXLWb.SaveAs strWorkBook

Resume Next

Case Else

DoCmd.Hourglass False

MsgBox Err.Number & " " & Err.Description

Stop

Resume 0

End Select

End Sub

buda düğme kodu yalnız unutma eskisini siler yenisini ekler

Kod:
Dim stFile As String

Dim strSQL2 As String

  strSQL2 = "SELECT * From sor1 "

            strSQL2 = strSQL2 & "WHERE DURUM Like '" & durumum & "' And YILAYGÜN=" & ayımyılım

    stFile = CurrentProject.Path & "\" & durumum & ".xls"

Kill stFile

Call CopyRs2Sheet(strSQL2, stFile, "Sayfa1", "A1")

sayfa 1 yazan yere sen istediğin yazabilirsin bunu bir döngüye bağlarsan her dönmede kişileri yeni bir sayfa gibi ekler

Sevgili esrefigit,

Yardım için teşekkür ederim.
Fakat, veritabanı konusunda genel olarak çok bilgili olduğum söylenemez dolayısıyla vb kodları konusunda çok iyi olmadığımdan, döngüye bağlamanın nasıl olduğunu bilmiyorum. İşin bu kısmını da benim için açıklığa kavuşturabilir misiniz?

Örnek:
Benim veritabanımdaki kişiler A,B ve C olsun. Sizin verdiğiniz kodlar A kişisinin verilerini yazdırdı diyelim, B ve C için ne yapmalıyım ki bu döngü devam etsin.

Saygılar

bunun için sanırım örnek eklemeniz gerekir

Örneği ekledim.

Bahsettiğim konuyu örneğe uyarlayacak olursak:
[ED] tablosundaki kişilerin bilgilerini excele atarken herbirini aynı dosyada ama ayrı sayfalara yerleştirmesini istiyorum.
Sizin vermiş olduğunu kodları ilave etmedim, yanlış birşeyler yapmamak için.
Veritabanı henüz tasarım aşamasında olduğundan tasarımın kusuruna bakmazsınız umarım. Img-grin

öncelikle tablo yapıların çok karmaşık olduğu için kod yavaş çalışmakta ama senin istediğin oldu
modül bölümü geneldir açıklamaya gerek yoktur lakin
kodun bu bölümünü açıklama gereği duydum diğer ilgilenen arkadaşlar içinde sanırım faydalı olur

Private Sub Komut0_Click()
rstkayit diye bir ado kaydı belirledik
Dim rstkayit As New ADODB.Recordset
-------------------------------------------
strsql diye bir string alanı oluşturdukki bununla tabloyu açalım
Dim strsql As String
----------------------------------------------
strsql diye bir string alanı oluşturdukki bununla tabloyu ikinci defa açalım
Dim strsql2 As String
------------------------------------------------------------
stfile diye bir string alan oluşturdukki buna Excel sayfasının yerini tarif edelim
Dim stFile As String
-----------------------------------------------------
ad diye bir alan oluşturdukki buna ilk açtığımız tablodan isimleri alalım
Dim ad As String
-------------------------------------------------------------
CurrentProject.Path veritabanımızın olduğu yer diğerini kendimiz ekledik
stFile = CurrentProject.Path & "\" & "ED.xls"
-----------------------------------------------------
burda strsql adlı alana tablonun sorgusunu yazdık
strsql = "SELECT * From GMDETAY "
---------------------------------------------------------
rstkayit alanının yeni bir kayıt alanı olduğunu söyledik
Set rstkayit = New ADODB.Recordset
----------------------------------------------------
rstkayit alanının strsql le verdiğimiz sorguyu açacağını belirttik ve sadece okunabilir olduğunu söyledik adLockReadOnly
rstkayit.Open strsql, CurrentProject.Connection, adOpenStatic, adLockReadOnly
---------------------------------------------------------------
burda rstkayit ile açtığımız tabloyu dolanmaya başlıyoruz ilk kayıttan itibaren
If rstkayit.EOF <> True Then
Do
-----------------------------------------------------------
ad alanına her kayıtta EDAD alanındaki isimi alıyoruz
ad = rstkayit("EDAD")
-----------------------------------------------------------------

strsql2 alanına bir sorgu belirledik ve bu sorguyu ad alanına verdiğimiz isim ile sınırladıkki her kayıtta exceel sayfasına her shet ayrı bir kayıt olarak alabilelim
strsql2 = "SELECT * From GMDETAY WHERE EDAD Like '" & ad & "*'"
----------------------------------------------------------------
burda modülü çağırıyoruz strsql2 açtırarak ona ad alanına aldığımız ismide ekleyerek A1 hücresinden başlamak üzere her sayfaya bir kişi olmak üzere kayıtları exceele aktarıyoruz
Call CopyRs2Sheet(strsql2, stFile, ad, "A1")
-----------------------------------------------------------
burda rstkayit sonraki kayıt sonraki kayıt diye döndürüyoruz
rstkayit.MoveNext
-------------------------------------------------
rstkayit son kaydına kadar bu işlem devam etsin diyoruz
Loop Until rstkayit.EOF
End If
-----------------------------------------------------------------
burda rstkayit da verdiğimiz tablo ile bağlantıyı kesiyoruz
Set rstkayit = Nothing
Set conn = Nothing
--------------------------------------------------------
sanırım bunu söylememe gerek yok
End Sub

unutmadan Excel sayfasını kesinlikle silmiyorsun ve veritabanının olduğu yerde olmalı ve aynı isimde olmalı şayet değiştirisen "ED.xls" burdanda değiştirmen gerekir

Sayfalar: 1 2 3

kdurmaz

esrefigit

kdurmaz

esrefigit

kdurmaz

esrefigit