AccessTr.neT

Bul · 07/10/2022, 12:07

Recordsetlerinizi ilgili aya göre filtrelenmiş olarak oluşturun

Bul · 07/10/2022, 12:18

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("C").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

Bul · 07/10/2022, 13:14

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

Bul · 07/10/2022, 13:21

Siz kodu nereye yazdınız?
Onlar zaten forumunuzdaki acilir kutu isimler

Bul · 07/10/2022, 13:22

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

Bul · 07/10/2022, 13:28

Ç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

AccessTr.neT

Kayıtları Excele Aktarma

Kayıtları Excele Aktarma

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

Giriş yap

Hesap oluştur

Konu Linkleri