AccessTr.neT

Tam Versiyon: Datagriddeki Verileri Exele Aktarma
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Datagriddeki verileri exele nasıl aktarabiliriz?
Sn:sngl07
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.Quit

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 & "\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.Quit

Dim 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
(30/04/2013, 19:42)sngl07 yazdı: [ -> ]Datagriddeki verileri exele nasıl aktarabiliriz?

Butonun click olayına bunu yazınız


Dim Excel As New Microsoft.Office.Interop.Excel.Application()
excel.Visible = True
Dim workbook As Microsoft.Office.Interop.Excel.Workbook = excel.Workbooks.Add(System.Reflection.Missing.Value)
Dim sheet1 As Microsoft.Office.Interop.Excel.Worksheet = excel.ActiveSheet
Dim StartCol As Integer = 2 ' excele hangi sütundan yazmaya başlasın
Dim StartRow As Integer = 1
Dim liste As New List(Of DataGridViewColumn)
liste.Add(DataGridView1.Columns(1)) ' datagridin hangi sütunlarını istiyorsan değiştir
liste.Add(DataGridView1.Columns(2))
liste.Add(DataGridView1.Columns(3))
liste.Add(DataGridView1.Columns(4))
liste.Add(DataGridView1.Columns(5))
liste.Add(DataGridView1.Columns(6))
liste.Add(DataGridView1.Columns(7))
liste.Add(DataGridView1.Columns(8))
liste.Add(DataGridView1.Columns(9))
liste.Add(DataGridView1.Columns(10))
liste.Add(DataGridView1.Columns(11))
liste.Add(DataGridView1.Columns(12))
liste.Add(DataGridView1.Columns(13))
liste.Add(DataGridView1.Columns(14))
liste.Add(DataGridView1.Columns(15))
liste.Add(DataGridView1.Columns(16))
liste.Add(DataGridView1.Columns(17))
liste.Add(DataGridView1.Columns(18))
liste.Add(DataGridView1.Columns(19))
liste.Add(DataGridView1.Columns(20))
liste.Add(DataGridView1.Columns(21))
liste.Add(DataGridView1.Columns(22))
liste.Add(DataGridView1.Columns(23))
liste.Add(DataGridView1.Columns(24))
liste.Add(DataGridView1.Columns(25))
liste.Add(DataGridView1.Columns(26))
liste.Add(DataGridView1.Columns(27))
liste.Add(DataGridView1.Columns(28))
liste.Add(DataGridView1.Columns(29))
liste.Add(DataGridView1.Columns(30))
liste.Add(DataGridView1.Columns(31))
liste.Add(DataGridView1.Columns(32))
liste.Add(DataGridView1.Columns(33))
liste.Add(DataGridView1.Columns(34))
liste.Add(DataGridView1.Columns(35))
liste.Add(DataGridView1.Columns(36))
liste.Add(DataGridView1.Columns(37))
liste.Add(DataGridView1.Columns(38))
liste.Add(DataGridView1.Columns(39))
liste.Add(DataGridView1.Columns(40))
liste.Add(DataGridView1.Columns(41))
liste.Add(DataGridView1.Columns(42))
liste.Add(DataGridView1.Columns(43))
liste.Add(DataGridView1.Columns(44))
liste.Add(DataGridView1.Columns(45))
liste.Add(DataGridView1.Columns(46))
liste.Add(DataGridView1.Columns(47))
liste.Add(DataGridView1.Columns(48))
liste.Add(DataGridView1.Columns(49))
liste.Add(DataGridView1.Columns(50))
liste.Add(DataGridView1.Columns(51))
liste.Add(DataGridView1.Columns(52))
liste.Add(DataGridView1.Columns(53))
liste.Add(DataGridView1.Columns(54))
liste.Add(DataGridView1.Columns(55))
liste.Add(DataGridView1.Columns(56))
liste.Add(DataGridView1.Columns(57))
liste.Add(DataGridView1.Columns(58))
liste.Add(DataGridView1.Columns(59))
liste.Add(DataGridView1.Columns(60))

For j As Integer = 0 To liste.Count - 1
Dim myRange As Microsoft.Office.Interop.Excel.Range = sheet1.Cells(StartRow, StartCol + j)
myRange.Value2 = liste(j).HeaderText
Next
StartRow = 2
For i As Integer = 0 To DataGridView1.Rows.Count - 1
For j As Integer = 0 To liste.Count - 1
Try
Dim myRange As Microsoft.Office.Interop.Excel.Range = sheet1.Cells(StartRow + i, StartCol + j)
myRange.Value2 = If(DataGridView1(liste(j).Name, i).Value Is Nothing, "", DataGridView1(liste(j).Name, i).Value)
Catch
End Try
Next
Next
MsgBox("Aktarım Bitti")
İlginize çok teşekkür ederim ama yapamadım Img-cray
Örnek olmayıncada bizim cevaplarımızda farazi oluyor.