关闭

导出excel

520人阅读 评论(0) 收藏 举报
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 LongByVal uExitCode As LongAs Long
    
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As StringByVal lpWindowName As StringAs Long
    
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongByVal wMsg As LongByVal wParam As LongByVal lParam As LongAs Long
    
Public Sub New(ByVal conn As SqlConnection)
        
MyBase.new()
        
Me.conn = conn
    
End Sub
    
'DataSetToExcelSheet函数将数据写到excel中
    Private Function DataTableToExcelSheet(ByVal heading As StringByVal 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 StringByVal Dataview As DataView, ByVal Sheet As ObjectAs 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 StringByVal Datatable As DataTable, ByVal ExcelFileName As StringAs 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 StringByVal DataView As DataView, ByVal ExcelFileName As StringAs 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 + 1800)
            DetectExcel 
= True
        
Else
            DetectExcel 
= False
        
End If
    
End Function
End Class
 
0
0

查看评论
* 以上用户言论只代表其个人观点,不代表CSDN网站的观点或立场
    个人资料
    • 访问:55746次
    • 积分:869
    • 等级:
    • 排名:千里之外
    • 原创:14篇
    • 转载:58篇
    • 译文:0篇
    • 评论:2条
    文章分类
    最新评论