2013年12月2日 星期一

轉 : DataGridView匯出至Excel


http://tw.myblog.yahoo.com/wcn-caspar/article?mid=805&prev=806&next=803&l=f&fid=25

''' <summary> 
''' DataGridView匯出至Excel 
''' </summary> 
''' <param name="DGV">欲匯出之DataGridView</param> 
''' <param name="ExportName">匯出檔案名稱</param> 
''' <param name="Hide">只顯示畫面欄位</param> 
''' <remarks></remarks> 

Public Sub DataGridViewExportToExcel(ByVal DGV As DataGridView, ByVal ExportName As String, ByVal Hide As Boolean) 
        Dim FileName As String = "C:\" & Format(Now, "yyyyMMdd_HH_mm_ss") & ExportName & ".xls" 
        Dim sw As StreamWriter = New StreamWriter(FileName, False, System.Text.Encoding.Default) 

        'Me.UseWaitCursor = True 
        Dim sData As String 
        If Hide = True Then 
            '表頭               
            Dim n As Integer = 0 
            For i As Integer = 0 To DGV.Columns.Count - 1 
                If DGV.Columns(i).Visible = True Then 
                    sw.Write(IIf(n = 0, "", vbTab) & DGV.Columns(i).HeaderText) 
                    n = n + 1 
                End If 
            Next 
            sw.WriteLine() 

            '資料                                                                                             
            For i As Integer = 0 To DGV.Rows.Count - 1 
                n = 0 
                For j As Integer = 0 To DGV.Columns.Count - 1 
                    If DGV.Columns(j).Visible = True Then 
                        'sw.Write(IIf(n = 0, "", vbTab) & Replace(DGV.Rows(i).Cells(j).Value, Chr(10), " ")) 
                        sData = IIf(IsDBNull(DGV.Rows(i).Cells(j).Value), "", DGV.Rows(i).Cells(j).Value) 
                        sData = Replace(sData, Chr(10), " "
                        sw.Write(IIf(n = 0, "", vbTab) & sData) 
                        n = n + 1 
                    End If 
                Next 
                sw.WriteLine() 
            Next 
        Else 
            '表頭               
            Dim n As Integer = 0 
            For i As Integer = 0 To DGV.Columns.Count - 1 
                sw.Write(IIf(n = 0, "", vbTab) & DGV.Columns(i).HeaderText) 
                n = n + 1 
            Next 
            sw.WriteLine() 

            '資料 
            For i As Integer = 0 To DGV.Rows.Count - 1 
                n = 0 
                For j As Integer = 0 To DGV.Columns.Count - 1 
                    'sw.Write(IIf(n = 0, "", vbTab) & Replace(DGV.Rows(i).Cells(j).Value, Chr(10), " ")) 
                    sData = IIf(IsDBNull(DGV.Rows(i).Cells(j).Value), "", DGV.Rows(i).Cells(j).Value) 
                    sData = Replace(sData, vbLf, " "
                    sw.Write(IIf(n = 0, "", vbTab) & sData) 
                    n = n + 1 
                Next 
                sw.WriteLine() 
            Next 
        End If 
        sw.Close() 

        MsgBox("檔案匯出至" & FileName, MsgBoxStyle.OkOnly, "檔案匯出"

        '開啟檔案 
        CreateObject("WScript.Shell").Run(FileName) 
    End Sub 

    Public Sub DataGridViewExportToExcel2(ByVal DGV As DataGridView, ByVal ExportName As String, ByVal Hide As Boolean) 
        Dim xlsApp, xlsWB, xlsSht As Object 
        xlsApp = CreateObject("Excel.Application"
        xlsWB = xlsApp.Workbooks.Add 
        xlsSht = xlsWB.Worksheets(1) 
        Dim FileName As String = "C:\" & Format(Now, "yyyyMMdd_HH_mm_ss") & ExportName & ".xls" 
        Dim i As Integer = 0 
        Dim j As Integer = 0 

        xlsApp.Visible = False 
        For i = 1 To DGV.Columns.Count 
            xlsSht.cells(1, i) = DGV.Columns(i - 1).HeaderText 
        Next 

        For j = 1 To DGV.Rows.Count - 1 
            For i = 0 To DGV.Columns.Count - 1 
                If IsDBNull(DGV.Rows(j - 1).Cells(i).Value) Then 
                    xlsSht.cells(j + 1, i + 1) = "" 
                Else 
                    xlsSht.cells(j + 1, i + 1) = DGV.Rows(j - 1).Cells(i).Value.ToString() 
                End If 
            Next 
        Next 

        xlsWB.saveas(FileName) 
        xlsApp.Visible = True 
        'xlsWB.Close() 
        'xlsApp.Quit() 
        'System.Runtime.InteropServices.Marshal.ReleaseComObject(xlsWB) 
        'xlsWB = Nothing 
        'System.Runtime.InteropServices.Marshal.ReleaseComObject(xlsApp) 
        xlsApp = Nothing 
        'GC.Collect() 
        'MsgBox("檔案匯出至" & FileName, MsgBoxStyle.OkOnly, "檔案匯出") 
        '開啟檔案 
        'CreateObject("WScript.Shell").Run(FileName) 
    End Sub