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 Subaş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.Close50 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_RS31 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
excl.Range("F3") = 1
excl.Range("F3").DataSeries _
Rowcol:=xlRows, _
Type:=xlLinear, _
Date:=xlDay, _
Step:=1, _
Stop:=31, _
Trend:=False