导出excel

Imports  System.Data.SqlClient
Imports  System.Math
Imports  System.Windows.Forms
Imports  System
Imports  Excel.ApplicationClass
Imports  Excel.XlLineStyle
Imports  Excel.XlPattern
Imports  Excel.XlBorderWeight
Imports  Excel.Constants
Imports  Excel.XlBordersIndex
Public   Class  clsDataToExcel
     Private  conn  As   New  SqlConnection
     Private   Declare   Function  TerminateProcess  Lib   " kernel32 "  ( ByVal  ApphProcess  As   Long ,  ByVal  uExitCode  As   Long )  As   Long
     Private   Declare   Function  FindWindow  Lib   " user32 "   Alias   " FindWindowA "  ( ByVal  lpClassName  As   String ,  ByVal  lpWindowName  As   String )  As   Long
     Private   Declare   Function  SendMessage  Lib   " user32 "   Alias   " SendMessageA "  ( ByVal  hWnd  As   Long ,  ByVal  wMsg  As   Long ,  ByVal  wParam  As   Long ,  ByVal  lParam  As   Long )  As   Long
     Public   Sub   New ( ByVal  conn  As  SqlConnection)
         MyBase .new()
         Me .conn  =  conn
     End Sub
     ' DataSetToExcelSheet函数将数据写到excel中
     Private   Function  DataTableToExcelSheet( ByVal  heading  As   String ,  ByVal  Datatable  As  DataTable,  ByVal  Sheet  As  Excel.Worksheet)  As   Boolean
         Dim  Row, Col, FieldIndex  As   Integer
         Dim  range  As   Object
         Dim  cols  As   String    ' cols标记列数
         Dim  result  As   Boolean   =   False

        Sheet.Activate()
         ' 全选单元格，设置其格式为文本
        range  =  Sheet.Cells
        range.NumberFormatLocal  =   " @ "
         Try
             '  标题 heading
            Row  =   1
            Col  =   1
            Sheet.Cells(Row, Col)  =  heading

             '  标题 heading居中****************
             If  Datatable.Columns.Count  <=   26   Then
                cols  =   Chr ( 65   +  Datatable.Columns.Count  -   1 )
             Else
                cols  =   " A "   &   Chr ( 65   +  Datatable.Columns.Count  -   26   -   1 )
             End   If
            cols  =   " A1: "   &  cols  &   " 1 "
            range  =  Sheet.Range(cols)
            range.HorizontalAlignment  =   - 4108
            range.Merge()

             '  列标题
            Row  =   1
            Col  =   1
             Dim  dtb  As   New  DataTable
             Dim  adp  As   New  SqlClient.SqlDataAdapter( " select columnname,discription from FieldDiscription where len(discription)<>0 " , conn)
            adp.Fill(dtb)
             Dim  dvw  As   New  DataView(dtb)
             For  FieldIndex  =   0   To  Datatable.Columns.Count  -   1
                dvw.RowFilter  =   " columnname=' "   &  Datatable.Columns(FieldIndex).ColumnName  &   " ' "
                Sheet.Cells(Row, Col)  =  dvw.Item( 0 ).Item( " discription " ).trim()
                Col  +=   1
             Next
            Row  =  Row  +   1

             Dim  dr  As  DataRow
             For   Each  dr  In  Datatable.Rows
                Col  =   1
                 For  FieldIndex  =   0   To  Datatable.Columns.Count  -   1
                    Sheet.Cells(Row, Col)  =  dr(FieldIndex)
                    Col  +=   1
                 Next
                Row  +=   1
             Next
            result  =   True
         Catch  ex  As  Exception
             MsgBox (ex.Message.ToString)
         End   Try

         Return  result
     End Function
     Private   Function  DataViewToExcelSheet( ByVal  heading  As   String ,  ByVal  Dataview  As  DataView,  ByVal  Sheet  As   Object )  As   Boolean
         Dim  Row, Col, FieldIndex  As   Integer
         Dim  range  As   Object
         Dim  cols  As   String    ' cols标记列数
         Dim  result  As   Boolean
        result  =   False

        Sheet.Activate()
         ' 全选单元格，设置其格式为文本
        range  =  Sheet.Cells
        range.NumberFormatLocal  =   " @ "

         Try
             '  标题 heading
            Row  =   1
            Col  =   1
            Sheet.Cells(Row, Col)  =  heading

             '  标题 heading居中****************
             If  Dataview.Table.Columns.Count  <=   26   Then
                cols  =   Chr ( 65   +  Dataview.Table.Columns.Count  -   1 )
             Else
                cols  =   " A "   &   Chr ( 65   +  Dataview.Table.Columns.Count  -   26   -   1 )
             End   If
            cols  =   " A1: "   &  cols  &   " 1 "
            range  =  Sheet.Range(cols)
            range.HorizontalAlignment  =   - 4108
            range.Merge()

             '  列标题
            Row  =   2
            Col  =   1

             Dim  dtb  As   New  DataTable
             Dim  adp  As   New  SqlClient.SqlDataAdapter( " select columnname,discription from FieldDiscription where len(discription)<>0 " , conn)
            adp.Fill(dtb)
             Dim  dvw  As   New  DataView(dtb)
             For  FieldIndex  =   0   To  Dataview.Table.Columns.Count  -   1
                dvw.RowFilter  =   " columnname=' "   &  Dataview.Table.Columns(FieldIndex).ColumnName  &   " ' "
                Sheet.Cells(Row, Col)  =  dvw.Item( 0 ).Item( " discription " ).trim()
                Col  +=   1
             Next

             '  表内容
            Row  =  Row  +   1

             ' Dim dr As DataRow
             For  i  As   Integer   =   0   To  Dataview.Count  -   1
                Col  =   1
                 For  FieldIndex  =   0   To  Dataview.Table.Columns.Count  -   1
                    Sheet.Cells(Row, Col)  =  Dataview.Item(i).Item(FieldIndex)
                    Col  +=   1
                 Next
                Row  +=   1
             Next
            result  =   True
         Catch  ex  As  Exception
             MsgBox (ex.Message.ToString)
         End   Try

         Return  result
     End Function
     Public   Function  DataTableToExcel( ByVal  heading  As   String ,  ByVal  Datatable  As  DataTable,  ByVal  ExcelFileName  As   String )  As   Boolean
         Dim  Excel  As  Excel.Application
         Dim  WorkBook  As  Excel.Workbook
         Dim  Sheet  As  Excel.Worksheet
         Dim  result  As   Boolean

         Dim  OldCursor  As  Cursor
         Dim  SaveDialog  As   New  SaveFileDialog

        result  =   False

        OldCursor  =  System.Windows.Forms.Cursors.Default
        System.Windows.Forms.Cursor.Current  =  System.Windows.Forms.Cursors.WaitCursor

         Try
             If   Me .DetectExcel  =   True   Then
                Excel  =   CType ( CreateObject ( " Excel.Application " ), Excel.Application)
                 ' '设置工作簿中工作表的数量
                Excel.SheetsInNewWorkbook  =   1
                WorkBook  =   CType (Excel.Workbooks.Add, Excel.Workbook)
                Sheet  =   CType (WorkBook.Worksheets( 1 ), Excel.Worksheet)
             Else
                 MsgBox ( " Excel已经在运行，请先关闭 " )
                 Return   False
             End   If
         Catch
             MsgBox ( " 无法调用Mircorsoft Excel!  "   &   Chr ( 13 )  &   Chr ( 10 )  &   " 请检查是否安装了Mircorsoft Excel。 " )
            System.Windows.Forms.Cursor.Current  =  OldCursor
             Return   False
         End   Try


         Try
            DataTableToExcelSheet(heading, Datatable, Sheet)
         Catch  ex  As  Exception
             MsgBox (ex.Message.ToString())
            Sheet  =   Nothing
            WorkBook.Close()
            WorkBook  =   Nothing
            Excel.Quit()
            Excel  =   Nothing
            GC.Collect()  ' 强制垃圾回收

            System.Windows.Forms.Cursor.Current  =  OldCursor
             Return   False
         End   Try

         ' If result Then 保存文件
         If  ExcelFileName  <>   ""   Then
            Excel.DisplayAlerts  =   False
            WorkBook.SaveAs(ExcelFileName)
         Else
            SaveDialog.Filter  =   " Microsoft Excel 文件(*.xls)|*.xls "
            SaveDialog.ShowDialog()

             If  SaveDialog.FileName  <>   ""   Then
                Excel.DisplayAlerts  =   False
                WorkBook.SaveAs(SaveDialog.FileName)
             End   If
            GC.Collect()  ' 强制垃圾回收
            SaveDialog  =   Nothing
         End   If


         ' 释放变量 
        Excel.DisplayAlerts  =   False
        Excel.Quit()
        Sheet  =   Nothing
         ' WorkBook = Nothing
         ' WorkBook.Close()

         ' Excel = Nothing

        System.Windows.Forms.Cursor.Current  =  OldCursor
        GC.Collect()  ' 强制垃圾回收
        System.Runtime.InteropServices.Marshal.ReleaseComObject(Excel)
         Return   True
     End Function
     Public   Function  DataViewToExcel( ByVal  heading  As   String ,  ByVal  DataView  As  DataView,  ByVal  ExcelFileName  As   String )  As   Boolean
         Dim  Excel  As  Excel.Application
         Dim  WorkBook  As  Excel.Workbook
         Dim  Sheet  As  Excel.Worksheet
         Dim  result  As   Boolean

         Dim  OldCursor  As  Cursor
         Dim  SaveDialog  As   New  SaveFileDialog
        result  =   False

        OldCursor  =  System.Windows.Forms.Cursors.Default
        System.Windows.Forms.Cursor.Current  =  System.Windows.Forms.Cursors.WaitCursor

         Try
            Excel  =   CType ( CreateObject ( " Excel.Application " ), Excel.Application)
            WorkBook  =   CType (Excel.Workbooks.Add, Excel.Workbook)
            Sheet  =   CType (WorkBook.Worksheets( 1 ), Excel.Worksheet)

         Catch
             MsgBox ( " 无法调用Mircorsoft Excel!  "   &   Chr ( 13 )  &   Chr ( 10 )  &   " 请检查是否安装了Mircorsoft Excel。 " )
            System.Windows.Forms.Cursor.Current  =  OldCursor
             Return   False
         End   Try

         Try
            DataViewToExcelSheet(heading, DataView, Sheet)
         Catch  ex  As  Exception
             MsgBox (ex.Message.ToString())
             Return   False
         End   Try

         ' If result Then 保存文件
         If  ExcelFileName  <>   ""   Then
             ' WorkBook.SaveAs(FileName:=ExcelFileName)
            Excel.DisplayAlerts  =   False
            WorkBook.SaveAs(ExcelFileName)
         Else
            SaveDialog.Filter  =   " Microsoft Excel 文件(*.xls)|*.xls "
            SaveDialog.ShowDialog()
             If  SaveDialog.FileName  <>   ""   Then
                Excel.DisplayAlerts  =   False
                WorkBook.SaveAs(SaveDialog.FileName)
             End   If
            SaveDialog  =   Nothing
         End   If

         ' 释放变量 
        Excel.DisplayAlerts  =   False
        Excel.Quit()
        Sheet  =   Nothing
         ' WorkBook = Nothing
         ' WorkBook.Close()

         ' Excel = Nothing
        GC.Collect()  ' 强制垃圾回收
        System.Windows.Forms.Cursor.Current  =  OldCursor
        GC.Collect()  ' 强制垃圾回收
        System.Runtime.InteropServices.Marshal.ReleaseComObject(Excel)
         Return   True
     End Function
     Private   Function  DetectExcel()  As   Boolean
         Const  WM_USER  =   1024
         Dim  hWnd  As   Long
        hWnd  =  FindWindow( " XLMAIN " ,  0 )
         If  hWnd  <>   0   Then   '  hWnd <> 0 means Excel is running. 
            SendMessage(hWnd, WM_USER  +   18 ,  0 ,  0 )
            DetectExcel  =   True
         Else
            DetectExcel  =   False
         End   If
     End Function
End Class