Arama yaparsanız sitede hem örnekler bölümünde hemde cevaplar bölümünde örnek mevcut aşağıdakilerde bunlardan birkaç tanesi ama yinede zahmet etmiyeyim derseniz kodlar aşağıda.
VSFlexGrid deki verileri excele aktarma
VB de Düşüy ara
VSFlexGrid1.SaveGrid App.Path & "\RaporVSFlexGrideGöreAyarlı.xls", flexFileExcel
MsgBox "Programın bulunduğu klasöre RaporVSFlexGrideGöreAyarlı.xls olarak kaydedildi."Dim appXL As New excel.Application
Dim wbk As excel.Workbook
Dim wks As excel.Worksheet
'==========================================================
Rem buraya açacağımız Excel dosyanın yolunu belirtiriz.
Set wbk = appXL.Workbooks.Open(App.Path & "\RaporAyarlanabilir.xls")
'==========================================================
Rem açılan Excel dosyasının sayfa numarası
wbk.Sheets(1).Select 'açılan Excel dosyasının sayfa numarası
'==========================================================
Rem exceli görünmez yapar True yazarsanız görünür yapar
appXL.Visible = False
'==========================================================
Rem Grid1 deki bilgiler aktarılıyor
For X = 0 To VSFlexGrid1.Rows - 1
For Y = 0 To VSFlexGrid1.Cols - 1
VSFlexGrid1.Row = X
VSFlexGrid1.Col = Y
appXL.Cells(X + 1, Y + 1) = VSFlexGrid1.Text
Next
Next
'==========================================================
Rem sayfayı yazıcıya gönderir
appXL.ActiveWindow.SelectedSheets.PrintOut Copies:=1
'==========================================================
Rem başka adla kaydeder
'appXL.ActiveWorkbook.SaveAs FileName:="C:Rapor.xls"
'==========================================================
Rem kaydetmeden kapatır False yazarsanız kayderek kapatır
wbk.Close Saved = True
'==========================================================
Rem dosyayı kapatır
appXL.Workbooks.Close
'==========================================================
Rem Excel i kapatır
appXL.Application.QuitDim I As Integer
Dim appXL As New excel.Application
Dim wbk As excel.Workbook
Dim wks As excel.Worksheet
'buraya açacağımız Excel dosyanın yolunu belirtiriz.
Set wbk = appXL.Workbooks.Open(App.Path & "\RaporAyarlarOtamatik.xls")
'açılan Excel dosyasının sayfa numarası
wbk.Sheets(1).Select
'exceli görünür yapar
appXL.Visible = True
'_________________________________________________________
appXL.Application.Cells(1, 1).Font.Size = 20
appXL.Application.Cells(1, 1).Font.Bold = True
'ExcelNesne.Application.Cells(1, 1).Font.Underline = True
appXL.Application.Cells(1, 1).Font.Color = vbBlue
'ExcelNesne.Application.Cells(1, 1).ColumnWidth = 60
appXL.Application.Cells(1, 1).Value = "ÖDEME RAPORU"
'__________________________________________________________
appXL.Application.Cells(2, 1).Font.Color = vbRed
appXL.Application.Cells(2, 1).ColumnWidth = 10
appXL.Application.Cells(2, 1).Value = "Tarih"
appXL.Application.Columns("A:A").Select
appXL.Application.Selection.NumberFormat = "m/d/yyyy"
appXL.Application.Range("A1").Select
'__________________________________________________________
appXL.Application.Cells(2, 2).Font.Color = vbRed
appXL.Application.Cells(2, 2).ColumnWidth = 46.6
appXL.Application.Cells(2, 2).Value = "Açıklama"
'__________________________________________________________
appXL.Application.Cells(2, 3).Font.Color = vbRed
appXL.Application.Cells(2, 3).ColumnWidth = 15
appXL.Application.Cells(2, 3).Value = "Gelir"
'__________________________________________________________
appXL.Application.Cells(2, 4).Font.Color = vbRed
appXL.Application.Cells(2, 4).ColumnWidth = 15
appXL.Application.Cells(2, 4).Value = "Gider"
I = 2
Adodc1.Recordset.MoveFirst
Do While Not Adodc1.Recordset.EOF = True
I = I + 1
appXL.Application.Cells(I, 1).Value = Adodc1.Recordset.Fields("Tarih")
appXL.Application.Cells(I, 2).Value = Adodc1.Recordset.Fields("Aciklama")
appXL.Application.Cells(I, 3).Value = Adodc1.Recordset.Fields("Gelir")
appXL.Application.Cells(I, 4).Value = Adodc1.Recordset.Fields("Gider")
Adodc1.Recordset.MoveNext
Loop
appXL.Application.ActiveWindow.SelectedSheets.PrintOut Copies:=1
'MsgBox "Programa Dön"
wbk.Close Saved = True
'dosyayı kapatır
appXL.Workbooks.Close
'excel i kapatır
appXL.Application.QuitDim I As Integer
If Adodc1.Recordset.RecordCount = 0 Then
MsgBox "Kayıt yok"
Exit Sub
End If
Dim ExcelNesne As Object
Set ExcelNesne = CreateObject("Excel.SHEET")
ExcelNesne.Application.Visible = True
'_________________________________________________________
ExcelNesne.Application.Cells(1, 1).Font.Size = 20
ExcelNesne.Application.Cells(1, 1).Font.Bold = True
'ExcelNesne.Application.Cells(1, 1).Font.Underline = True
ExcelNesne.Application.Cells(1, 1).Font.Color = vbBlue
'ExcelNesne.Application.Cells(1, 1).ColumnWidth = 60
ExcelNesne.Application.Cells(1, 1).Value = "KASA RAPORU"
'__________________________________________________________
ExcelNesne.Application.Cells(2, 1).Font.Color = vbRed
ExcelNesne.Application.Cells(2, 1).ColumnWidth = 10
ExcelNesne.Application.Cells(2, 1).Value = "Tarih"
ExcelNesne.Application.Columns("A:A").Select
ExcelNesne.Application.Selection.NumberFormat = "m/d/yyyy"
ExcelNesne.Application.Range("A1").Select
'__________________________________________________________
ExcelNesne.Application.Cells(2, 2).Font.Color = vbRed
ExcelNesne.Application.Cells(2, 2).ColumnWidth = 46.6
ExcelNesne.Application.Cells(2, 2).Value = "Açıklama"
'__________________________________________________________
ExcelNesne.Application.Cells(2, 3).Font.Color = vbRed
ExcelNesne.Application.Cells(2, 3).ColumnWidth = 15
ExcelNesne.Application.Cells(2, 3).Value = "Gelir"
'__________________________________________________________
ExcelNesne.Application.Cells(2, 4).Font.Color = vbRed
ExcelNesne.Application.Cells(2, 4).ColumnWidth = 15
ExcelNesne.Application.Cells(2, 4).Value = "Gider"
I = 2
Adodc1.Recordset.MoveFirst
Do While Not Adodc1.Recordset.EOF = True
I = I + 1
ExcelNesne.Application.Cells(I, 1).Value = Adodc1.Recordset.Fields("Tarih")
ExcelNesne.Application.Cells(I, 2).Value = Adodc1.Recordset.Fields("Aciklama")
ExcelNesne.Application.Cells(I, 3).Value = Adodc1.Recordset.Fields("Gelir")
ExcelNesne.Application.Cells(I, 4).Value = Adodc1.Recordset.Fields("Gider")
Adodc1.Recordset.MoveNext
Loop
ExcelNesne.Application.ActiveWindow.SelectedSheets.PrintOut Copies:=1
MsgBox "Programa Dön"Dim I As Integer
Dim appXL As New excel.Application
Dim wbk As excel.Workbook
Dim wks As excel.Worksheet
'buraya açacağımız Excel dosyanın yolunu belirtiriz.
Set wbk = appXL.Workbooks.Open(App.Path & "\RaporAyarlanır.xls")
'açılan Excel dosyasının sayfa numarası
wbk.Sheets(1).Select
'exceli görünür yapar
appXL.Visible = False
I = 1
Adodc1.Recordset.MoveFirst
Do While Not Adodc1.Recordset.EOF = True
I = I + 1
appXL.Application.Cells(I, 1).Value = Adodc1.Recordset.Fields("ID")
appXL.Application.Cells(I, 2).Value = Adodc1.Recordset.Fields("Tarih")
appXL.Application.Cells(I, 3).Value = Adodc1.Recordset.Fields("Aciklama")
appXL.Application.Cells(I, 4).Value = Adodc1.Recordset.Fields("Gelir")
appXL.Application.Cells(I, 5).Value = Adodc1.Recordset.Fields("Gider")
Adodc1.Recordset.MoveNext
Loop
'appXL.Application.ActiveWindow.SelectedSheets.PrintOut Copies:=1
'MsgBox "Programa Dön"
wbk.Close Saved = True
'dosyayı kapatır
appXL.Workbooks.Close
'excel i kapatır
appXL.Application.Quit