Skip to main content

AccessTr.neT

Kayıt Ol

 | Facebook ile Bağlan  | Twitter İle Bağlan | Google+ İle Bağlan

Kayıtları Excele Aktarma

angelos
angelos
Access Cevaplanmış Soruları
15
685

Kayıtları Excele Aktarma

#7
atoykan
Uzman
atoykan
Bul
Uzman
Adı Soyadı:
Konum: İstanbul
Ofis Versiyonu: Ofis 2019 64 Bit
Son Oturumu: Bugün,00:57
Yorumları: 1.478
Konuları: 3
Kayıt Tarihi: 23/02/2020
Teşekkür Puanı: 207
Mesleğiniz: CIO, Yazılım
Recordsetlerinizi ilgili aya göre filtrelenmiş olarak oluşturun
Cevapla
#8
berduş
Berduş
berduş
Bul
Uzman
Adı Soyadı: ha....
Konum: -
Ofis Versiyonu: Ofis 2019 64 Bit
Son Oturumu: Bugün,09:59
Yorumları: 8.499
Konuları: 94
Kayıt Tarihi: 30/07/2014
Teşekkür Puanı: 1.051
excele aktarma kodunuzu aşağıdaki kodla değiştirip dener misiniz?
Private Sub aktarexcel_Click()

Dim excl As Excel.Application

Dim KTP1 As Excel.Workbook

Dim SYF As Excel.Worksheet

Dim Sql As String

DoCmd.SetWarnings False

Dim rs1 As Recordset

    



If MsgBox("Bilgileriniz Excele Aktarılsın mı?", vbInformation + vbYesNo + vbDefaultButton1, "deneme") = vbNo Then Exit Sub





Set excl = CreateObject("Excel.Application")

With excl



      .Application.Visible = True

      .UserControl = True



End With



        Set KTP1 = excl.Workbooks.Add

        Set SFY = KTP1.Worksheets(1)

Dim ADO_RS As ADODB.Recordset



Set ADO_RS = New ADODB.Recordset

SQL = "SELECT Rs1.id, Rs1.sicil, Rs1.adsoyad, Rs1.rutbe, ""KOM"" AS İfade1, Rs0.E1, Rs0.E2, Rs0.E3, Rs0.E4, Rs0.E5, " & _

                "Rs0.E6, Rs0.E7, Rs0.E8, Rs0.E9, Rs0.E10, Rs0.E11, Rs0.E12, Rs0.E13, Rs0.E14, Rs0.E15, Rs0.E16, Rs0.E17, Rs0.E18, " & _

                "Rs0.E19, Rs0.E20, Rs0.E21, Rs0.E22, Rs0.E23, Rs0.E24, Rs0.E25, Rs0.E26, Rs0.E27, Rs0.E28, Rs0.E29, Rs0.E30, Rs0.E31, " & _

                "Rs0.CalisilanGun, Rs2.katsayi, Rs2.puan, [katsayi]*[puan] AS Gcn " & _

      "FROM tblhsp AS Rs2, PERSONEL1 AS Rs1 INNER JOIN tazminat AS Rs0 ON Rs1.id = Rs0.ADISOYADI " & _

      "WHERE (((Rs0.YIL)=" & Me.cmbYear & ") AND ((Rs0.AY)=" & Me.cmbMonth & "));"



ADO_RS.CursorLocation = adUseClient 'bu satır eklenince daha hızlı

ADO_RS.Open SQL, CurrentProject.Connection, 3, 1



'YOKLAMA KİTABINDA SAYFA OLUŞTURTURUYORUZ EĞER SAYFA VARSA AYNI İZİMDEN SONUNA 1 EKLEYEREK SAYFA OLUŞTURUR

            SyfAdi = "OPERASYON LİSTESİ"

            SyfAdiTmp = SyfAdi

            SyfNo = 0

            Do While WorksheetExists(SyfAdiTmp, KTP1) = True

            SyfNo = SyfNo + 1

            SyfAdiTmp = SyfAdi & IIf(SyfNo = 0, "", "(" & SyfNo & ")")

            Loop

            excl.Sheets.Add.Name = SyfAdiTmp

'###########################################################################################################



excl.Sheets(SyfAdiTmp).PageSetup.Orientation = xlLandscape

excl.Sheets(SyfAdiTmp).PageSetup.LeftMargin = "18" 'sol sayfa genişliği

excl.Sheets(SyfAdiTmp).PageSetup.RightMargin = "15" 'sağ sayfa genişliği

excl.Sheets(SyfAdiTmp).PageSetup.TopMargin = "15" 'üst sayfa genişliği

excl.Sheets(SyfAdiTmp).PageSetup.BottomMargin = "15" 'alt sayfa genişliği

excl.Sheets(SyfAdiTmp).PageSetup.HeaderMargin = "18" 'üst bilgi genişliği

excl.Sheets(SyfAdiTmp).PageSetup.FooterMargin = "18" 'alt bilgi genişliği

excl.Sheets(SyfAdiTmp).PageSetup.Zoom = 59



'########################################################################################################

With SYF

'Excl.Range("A:N").Font.Name = "Times New Roman"

'Excl.Range("A:N").VerticalAlignment = xlCenter 'ortaya hizalaR

'Excl.Range("A:N").HorizontalAlignment = xlCenter 'ortaya hizalar

'Excl.Range("A:N").ColumnWidth = 24 'SÜTUN GENİŞLİĞİ AYARLA

'Excl.Range("A1").RowHeight = 35 'SATIR YÜKSEKLİĞİ AYARLAR

'Excl.Range("A1").Font.size = 18 ' YAZININ KARAKTER BOYUTUNU BELİRLER

'Excl.Range("A2:N2").Font.Bold = True 'YAZIYI KALIN YAPAR

'Excl.Range("A1:N1").MergeCells = True 'Hücreler Birleştiriliyor

'Excl.Range("A1:N1").Interior.ColorIndex = 45 'HÜCRENİN ARKA PLAN RENGİ





excl.Range("A1:AN1").MergeCells = True 'Hücreler Birleştiriliyor

excl.Range("A2:AN2").MergeCells = True 'Hücreler Birleştiriliyor

excl.Range("A1") = "............... TAZMİNATI LİSTESİDİR"

excl.Range("A2") = "........................... ŞUBE MÜDÜRLÜĞÜ (                        )TARİHLERİ ARASI ........... TAZMİNATI"



excl.Range("A3") = "S/NO"

excl.Range("A:A").HorizontalAlignment = xlCenter



excl.Range("A3").VerticalAlignment = xlCenter

excl.Range("A3").HorizontalAlignment = xlCenter



excl.Range("B3") = "SİCİL"

excl.Range("B3").VerticalAlignment = xlCenter

excl.Range("B3").HorizontalAlignment = xlLeft

'excl.Range("B3:B90").HorizontalAlignment = xlCenter





excl.Range("C3") = "ADI SOYADI"

excl.Range("C3").VerticalAlignment = xlCenter

excl.Range("C3").HorizontalAlignment = xlLeft

'excl.Range("C3:C90").HorizontalAlignment = xlLeft



excl.Range("D3") = "RÜTBE"

excl.Range("D3").VerticalAlignment = xlCenter

excl.Range("D3").HorizontalAlignment = xlLeft

'excl.Range("C3:C90").HorizontalAlignment = xlLeft



excl.Range("E3") = "BİRİMİ"

excl.Range("E3").VerticalAlignment = xlCenter

excl.Range("E3").HorizontalAlignment = xlCenter

excl.Range("E3:E90").HorizontalAlignment = xlLeft





excl.Range("AK3") = "Çalışılan Gün"

excl.Range("AL3") = "KATSAYI"

excl.Range("AM3") = "PUAN"

excl.Range("AN3") = "ELE GEÇEN"





excl.Range("AK3:AN3").VerticalAlignment = xlCenter

excl.Range("AK3:AN3").HorizontalAlignment = xlCenter

'excl.Range("F3:AJ3").RowHeight = 80



excl.Range("A1:AN2").Font.Bold = True 'YAZIYI KALIN YAPAR

excl.Range("A1:AN2").VerticalAlignment = xlCenter 'ortaya hizalaR

excl.Range("A1:AN2").HorizontalAlignment = xlCenter 'ortaya hizalar

excl.Range("A1:AN2").RowHeight = 15 'SATIR YÜKSEKLİĞİ AYARLAR



excl.Range("A3:E3").Font.Bold = True 'YAZIYI KALIN YAPAR

excl.Range("A3:E3").Font.Size = 12



'excl.Range("F3:AJ3").Orientation = 90 'Metin Yönü

 excl.Range("F3") = 1

 excl.Range("F3").DataSeries _

                  Rowcol:=xlRows, _

                  Type:=xlLinear, _

                  Date:=xlDay, _

                  Step:=1, _

                  Stop:=31, _

                  Trend:=False





'seçili alanlara kenarlık ekleme kodu

excl.Range("A1:AN2").Borders.LineStyle = xlContinuous

excl.Range("A3:AN70").HorizontalAlignment = xlCenter



excl.Range("A:A").ColumnWidth = 7 'SÜTUN GENİŞLİĞİ AYARLA

excl.Range("B:B").ColumnWidth = 10 'SÜTUN GENİŞLİĞİ AYARLA

excl.Range("CLol").ColumnWidth = 20

excl.Range("E:E").ColumnWidth = 7





excl.Range("F:AJ").ColumnWidth = 4



'excl.Range("AJ:AJ").ColumnWidth = 4

excl.Range("AK:AN").ColumnWidth = 10



excl.Range("F4:AJ90").HorizontalAlignment = xlCenter





On Error Resume Next

' Excel e veri aktarma kodları

 excl.Range("A4").CopyFromRecordset ADO_RS

i = ADO_RS.RecordCount + 4

ADO_RS.Close



excl.Range("A3", "AN" & i - 1).Borders.LineStyle = xlContinuous



End With

excl.Visible = True

Set excl = Nothing





DoCmd.SetWarnings True



End Sub
aşağıda bazı kodların daha pratik halleri gösterilmiştir
döngüyle aktarmak yerine toplu olarak aktarma kodunu kullanmanız işlemi hızlandırır
      Set rs0 = CurrentDb.OpenRecordset("tazminat")

        Set Rs2 = CurrentDb.OpenRecordset("tblhsp")

        Set rs1 = CurrentDb.OpenRecordset("PERSONEL1")

        Do Until rs1.EOF

      

        excl.Cells(i, "A") = rs1(0)

  ....

        excl.Cells(i, "AN") = Rs2(1) * Rs2(2)

        

      i = i + 1

      

  rs1.MoveNext

  rs0.MoveNext

      

    Loop

  

rs1.Close


50 satırlık döngülü kod yerine aşağıdaki kod daha pratik
en azından döngü olmadığından daha hızlı
Dim ADO_RS As ADODB.Recordset



Set ADO_RS = New ADODB.Recordset

SQL = "SELECT Rs1.id, Rs1.sicil, Rs1.adsoyad, Rs1.rutbe, ""KOM"" AS İfade1, Rs0.E1, Rs0.E2, Rs0.E3, Rs0.E4, Rs0.E5, " & _

                "Rs0.E6, Rs0.E7, Rs0.E8, Rs0.E9, Rs0.E10, Rs0.E11, Rs0.E12, Rs0.E13, Rs0.E14, Rs0.E15, Rs0.E16, Rs0.E17, Rs0.E18, " & _

                "Rs0.E19, Rs0.E20, Rs0.E21, Rs0.E22, Rs0.E23, Rs0.E24, Rs0.E25, Rs0.E26, Rs0.E27, Rs0.E28, Rs0.E29, Rs0.E30, Rs0.E31, " & _

                "Rs0.CalisilanGun, Rs2.katsayi, Rs2.puan, [katsayi]*[puan] AS Gcn " & _

      "FROM tblhsp AS Rs2, PERSONEL1 AS Rs1 INNER JOIN tazminat AS Rs0 ON Rs1.id = Rs0.ADISOYADI " & _

      "WHERE (((Rs0.YIL)=" & Me.cmbYear & ") AND ((Rs0.AY)=" & Me.cmbMonth & "));"



ADO_RS.CursorLocation = adUseClient

ADO_RS.Open SQL, CurrentProject.Connection, 3, 1

 excl.Range("A4").CopyFromRecordset ADO_RS

31 satırlık 
excl.Range("F3") = 1

excl.Range("G3") = 2

excl.Range("H3") = 3

excl.Range("I3") = 4

excl.Range("J3") = 5

excl.Range("K3") = 6

excl.Range("L3") = 7

excl.Range("M3") = 8

excl.Range("N3") = 9

excl.Range("O3") = 10

excl.Range("P3") = 11

excl.Range("Q3") = 12

excl.Range("R3") = 13

excl.Range("S3") = 14

excl.Range("T3") = 15

excl.Range("U3") = 16

excl.Range("V3") = 17

excl.Range("W3") = 18

excl.Range("X3") = 19

excl.Range("Y3") = 20

excl.Range("Z3") = 21

excl.Range("AA3") = 22

excl.Range("AB3") = 23

excl.Range("AC3") = 24

excl.Range("AD3") = 25

excl.Range("AE3") = 26

excl.Range("AF3") = 27

excl.Range("AG3") = 28

excl.Range("AH3") = 29

excl.Range("AI3") = 30

excl.Range("AJ3") = 31
yerine 
excl.Range("F3") = 1

 excl.Range("F3").DataSeries _

                                Rowcol:=xlRows, _

                                Type:=xlLinear, _

                                Date:=xlDay, _

                                Step:=1, _

                                Stop:=31, _

                                Trend:=False
Cevapla
#9
angelos
Aktif Üye
angelos
Bul
Aktif Üye*
Adı Soyadı:
Konum: İzmir
Ofis Versiyonu: Belirtilmemiş
Son Oturumu: 06/03/2023,16:46
Yorumları: 107
Konuları: 24
Kayıt Tarihi: 05/02/2011
Teşekkür Puanı: 6
cmbyear ve cmbmounth parametre değeri istiyor açılmıyor varsayılan değer yazmışsınız siz zaten ekstra yapmam gereken birşey varmı acaba merakla sonucu görmek istiyorum. Ayrıca emek vermişsiniz çok teşekkür ederim
Cevapla
#10
berduş
Berduş
berduş
Bul
Uzman
Adı Soyadı: ha....
Konum: -
Ofis Versiyonu: Ofis 2019 64 Bit
Son Oturumu: Bugün,09:59
Yorumları: 8.499
Konuları: 94
Kayıt Tarihi: 30/07/2014
Teşekkür Puanı: 1.051
Siz kodu nereye yazdınız?
Onlar zaten forumunuzdaki acilir kutu isimler
Cevapla
#11
angelos
Aktif Üye
angelos
Bul
Aktif Üye*
Adı Soyadı:
Konum: İzmir
Ofis Versiyonu: Belirtilmemiş
Son Oturumu: 06/03/2023,16:46
Yorumları: 107
Konuları: 24
Kayıt Tarihi: 05/02/2011
Teşekkür Puanı: 6
excele aktar butonu tıklandığında kodunu sizin verdiğiniz kod ile değiştirdim sadece
(07/10/2022, 13:22)angelos yazdı: excele aktar butonu tıklandığında kodunu sizin verdiğiniz kod ile değiştirdim sadece
Özür diliyorum kodu tamamen yapıştırınca Private Sub aktarexcel_Click() iki tane olmuş açıldı inceliyorum
Son Düzenleme: 07/10/2022, 13:23, Düzenleyen: angelos.
Cevapla
#12
angelos
Aktif Üye
angelos
Bul
Aktif Üye*
Adı Soyadı:
Konum: İzmir
Ofis Versiyonu: Belirtilmemiş
Son Oturumu: 06/03/2023,16:46
Yorumları: 107
Konuları: 24
Kayıt Tarihi: 05/02/2011
Teşekkür Puanı: 6
Çok teşekkür ediyorum harika çalışıyor. Hakkınız helal edin uğraştırdım sizi, geçici tablo oluşturmadan hallettiniz yıl ve ay bazında sorgu oluşturarak heralde ben bu sorguyu günlerce yazamazdım çok fırın ekmek yememiz lazım daha. Tekrar teşekkürler
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da
Task