Accessten Excele Dögüsel Veri Aktarımı

1 2 3
09/09/2020, 15:52

orderyazbim

Form listesine görünen kayıtları hocam. Listedeki kayıtlar sorgudan alınacak. Saygılar.
09/09/2020, 16:03

berduş

listeniz bir sorguya değil tabloya bağlı ve tablodaki tüm verileri alıyor o nedenle sorudum. her ekle butonuna bastığınızda tüm kayıtları tekrar tekrar excele mi aktaracak yoksa sadece Excel sayfasında olmayan kayıtları mı aktaracak yada Access tablosunda değişiklik olanları da mı aktaracak
eğer amacınız Access tablosundaki tüm verilerin excele aktarılmasını sağlamaksa o nispeten kolay
excel açılır sayfa silinir sonra da verdiğim kod ile yeni bir sayfa olarak eklenebilir ki en basit ve hızlısı bu olur gibi
09/09/2020, 16:18

orderyazbim

Evet hocam tablodaki kayıtlar yeniden yazdırılacak. Excel deki elektronik tablo önceden biçimlendirilerek hazırlandığı için biçimlendirmenin bozulmaması istiyorum. Başlıklar, Hücre çerçeveleri, renklendirmeler yazıtipi vs. Önceden hazırlamış olan başlıklar altına verilerin gelmesi. Yine ekte örnek Excel tablosuna veri aktardığımı düşünürsek verilerin başlık olmadan görüntüdeki başlıklar altına işlenmesi gibi.  Ama olmazsada dediğiniz yöntemlerle çözüm bulmaya çalışacağım. İlgi ve Alakanıza teşekür eder saygılarımı sunarım.


09/09/2020, 17:50

berduş

dilerim işinize yarar
referanslardan Microsoft Excel Object Library eklenmeli
buton kodu
Dim TabloAdi As String
Dim XlAd As String
Dim SyfAd As String

TabloAdi = "isimler"
XlAd = CurrentProject.Path & "\Deneme.xlsx"
SyfAd = "isimler" '& "$"

'hy Excele sayfasına verileri biçimli aktarma_____________________________
Dim dbs As DAO.Database
Dim rsSQL As DAO.Recordset
Dim StrAna As String

Set dbs = CurrentDb
StrAna = "SELECT [adi],[soyadi],[yaşı],[ilçe] FROM isimler" 'ya alanların ismi tek tek yazılacak yada _
                                                            sadece gerekli alanların olduğu bir sorgu oluşturup oradan select * diyeceksiniz
Set rsSQL = dbs.OpenRecordset(StrAna, dbOpenSnapshot)

If rsSQL.RecordCount > 0 Then
rsSQL.MoveLast
rsSQL.MoveFirst
Else
Exit Sub
End If
'hy Exceli aç
   
    Dim XlAc As Excel.Application
    Dim XlKtp As Excel.Workbook
    Dim XlSyf As Excel.Worksheet
    Dim xRng As Excel.Range
    Dim SonStr As Long

    Set XlAc = CreateObject("Excel.Application")
    Set XlKtp = XlAc.Workbooks.Open(XlAd)
    Set XlSyf = XlKtp.Worksheets(SyfAd)
    XlAc.Visible = False
    SonStr = XlSyf.Cells(XlSyf.Rows.Count, 2).End(xlUp).row + 1 'XlAc.UsedRange.Rows(XlAc.UsedRange.Rows.Count).row
    Debug.Print SonStr
  XlSyf.Range("B2:Z" & SonStr).ClearContents
    XlSyf.Range("B2").CopyFromRecordset rsSQL

rsSQL.Close
Set rsSQL = Nothing

'XlSyf.Range("A1").CurrentRegion.Select
Set xRng = XlAc.Selection
With xRng
'    .Columns.AutoFit
'    .Borders.LineStyle = xlContinuous
    .BorderAround LineStyle:=xlContinuous ', Weight:=xlThick
End With

XlKtp.Save
XlAc.Quit

    Set XlAc = Nothing
    Set XlKtp = Nothing
    Set XlSyf = Nothing
    Set xRng = Nothing
MsgBox "Excele Aktarma bitti"
09/09/2020, 22:48

orderyazbim

sayın berduş, yardımlarınız için teşekkür eder saygılarımı sunarım. "Autmation error Kitaplık kaydedilmemiş" hatası alıyorum.
09/09/2020, 23:03

berduş

benim eklediğm dosyada mı verdi hatayı?
referansları kontrol eder misiniz, sürüm sorunu olabilir
1 2 3