' REFERANSLARDAN MİCROSOFT Excel ... OBJECT LİBRARY TANIMLAMINIZ GEREKİYOR..
Dim Exapp As Excel.Application
Dim objWsh As Object
Dim rs As Recordset
Dim yol As String
Dim x As Long
Dim r As Range
Dim GTarih As String
'On Error Resume Next
Set Exapp = GetObject("", "excel.application")
If Err.Number <> 0 Then
Err.Clear
Set Exapp = CreateObject("Excel.Application")
End If
' On Error GoTo Error_Handler
'exel yol tanımlıyoruz..
yol = CurrentProject.Path & "\yeni.xlsx"
'exceli açarak yükler.. false derseni.. exceli açmadan yükler.. size kalmış
Exapp.Visible = True
Exapp.Workbooks.Open yol
GTarih = Date
For Each objWsh In Exapp.Worksheets
If objWsh.Name = GTarih Then
Exapp.Worksheets(GTarih).Delete
End If
Next
Exapp.Visible = True
Exapp.Sheets("Sayfa1").Copy Before:=Exapp.Sheets(1)
Exapp.ActiveSheet.Name = Date
'eski Excel verileri siliyoruz...
With Exapp
.Range("a24", .Range("a24").End(xlDown).End(xlDown).End(xlToRight)).Select
.Range("a24", .Range("a24").End(xlDown).End(xlDown).End(xlToRight)).Delete
.Range("a24").Select
End With
Exapp.Visible = True
'With Exapp
'Set r = Cells(5, 27)
'r.Delete
'End With
'rapor sorgusunu açılıyor...
Set rs = CurrentDb.OpenRecordset("arac_tablo_s")
x = 24
Do While Not rs.EOF
With Exapp
.Cells(x, 1) = rs("no") ' 1 A KOLONU
.Cells(x, 2) = rs("Model") '2 B KOLONUDUR
.Cells(x, 3) = rs("myili")
End With
rs.MoveNext
x = x + 1
Loop
'SORGUYU KAPATIYORUZ..
rs.Close
'İŞLEMİ BİTİRİYORUZ.. VE ÇIKIYORUZ..
'Exit Sub
'Error_Handler:
'Exapp.ActiveWorkbook.Close True
'Exapp.Workbooks.Close
'Exapp.Quit
'Set Exapp = Nothing
'Resume 0
Geçerli tarih isminde yeni sayfa oluşturur ve verileri yeni sayfaya aktarır. Aynı isimde sayfa var ise sayfayı siler ve yeni sayfa oluşturur.
