导出excel

原创 2007年09月26日 12:06:00
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
 

HTML用JS导出Excel的五种方法

这五种方法前四种方法只支持IE浏览器,最后一个方法支持当前主流的浏览器(火狐,IE,Chrome,Opera,Safari) html 表格导出道 ...
  • aa122273328
  • aa122273328
  • 2015年12月23日 17:37
  • 83934

JS直接导出excel 兼容ie、chrome、firefox

var idTmr; function getExplorer() { var explorer = window.navigator....
  • sinat_15114467
  • sinat_15114467
  • 2016年04月08日 17:47
  • 35420

PowerDesigner 数据库设计导出到Excel

在PowerDesigner 中 ctrl+shift+x 弹出执行脚本界面,输入如下代码就会生成 Excel 代码一:所有的表在同一个 Sheet 页中 '***********...
  • Bin594505536
  • Bin594505536
  • 2016年01月14日 14:55
  • 3112

js导出EXCEL js导出EXCEL

参考一:http://wenku.baidu.com/view/7b81f3eb6294dd88d0d26b57.html 参考二: js导出EXCEL js导出EXCEL //导...
  • smeyou
  • smeyou
  • 2012年09月19日 15:03
  • 15783

MVC+jQuery 无刷新导出EXCEL的过程(伪excel格式)

MVC+jQuery 无刷新导出EXCEL的过程(伪excel格式): 伪excel格式:用excel能打开显示正常,但会打开会有提示。 1、在网页中建立Jquery过程,实现无刷新下载 ...
  • zhgl7688
  • zhgl7688
  • 2016年03月02日 17:52
  • 729

PowerDesigner导出excel

1. 在PowerDesigner菜单栏中,依次点击“Tools ->Excute Commands->Edit/Run Script..” 2. 然后执行以下 脚本 Option Explicit ...
  • jueshengtianya
  • jueshengtianya
  • 2016年01月29日 15:09
  • 1357

用JS进行Excel 三种导出方式

"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">                    WEB页面导出为EXCEL文档的方法...
  • Lucky_LXG
  • Lucky_LXG
  • 2017年01月14日 10:54
  • 7031

asp.net 使用NPOI实现导出Excel功能

asp.net 使用NPOI实现导出Excel功能
  • LanMangFeiGe
  • LanMangFeiGe
  • 2017年04月27日 13:53
  • 3309

在java中使用FreeMark导出数据到excel表格

主要有一下几步: 1.导入需要的jar:freemarker-2.3.19.jar。 2.根据需要作出导出模板 3.在WebRoot下面建template文件夹,把制作的模板扔到这个文件夹下面 4.编...
  • leipeng321123
  • leipeng321123
  • 2016年07月06日 11:19
  • 5166

POI 通用导出Excel(.xls,.xlsx)

POI操作EXCEL对象 HSSF:操作Excel 97(.xls)格式 XSSF:操作Excel 2007 OOXML (.xlsx)格式,操作EXCEL内存占用高于HSSF SXSSF...
  • houxuehan
  • houxuehan
  • 2016年03月23日 08:53
  • 57007
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:导出excel
举报原因:
原因补充:

(最多只允许输入30个字)