程序博客网 > 玩王者荣耀网络延迟高

求一个Vb.net 2005导出Excel 的类

来源：互联网 发布：玩王者荣耀网络延迟高 编辑：程序博客网 时间：2024/05/21 09:46
回复于：2007-12-05 14:30:54
_
Public Class ExportExcel
  Private s As New StringBuilder()
   
   
  '/ <summary>
  '/ Export Excel use GridView data
  '/ </summary>
  '/ <param name="Typename"></param>
  '/ <param name="TempGrid"></param>
  Public Shared Sub GenerateByGridView(Typename As String, TempGrid As GridView)
  HttpContext.Current.Response.Clear()
  'HttpContext.Current.Response.Buffer = true;
  HttpContext.Current.Response.Charset = "utf-8"
  Dim Filename As String = Typename + ".xls"
  HttpContext.Current.Response.AppendHeader("Content-Disposition", "online;filename=" + Filename)
  HttpContext.Current.Response.ContentEncoding = System.Text.Encoding.GetEncoding("utf-8")
  HttpContext.Current.Response.ContentType = "application/ms-excel"
  'this.EnableViewState = false;
  Dim oStringWriter As New System.IO.StringWriter()
  Dim oHtmlTextWriter As New System.Web.UI.HtmlTextWriter(oStringWriter)
  TempGrid.RenderControl(oHtmlTextWriter)
  HttpContext.Current.Response.Write(oStringWriter.ToString())
  HttpContext.Current.Response.End()
  End Sub 'GenerateByGridView
   
   
  '/ <summary>
  '/ Export Excel use Html string data
  '/ </summary>
  '/ <param name="Typename"></param>
  '/ <param name="TempHtml"></param>
  Public Shared Sub GenerateByHtmlString(Typename As String, TempHtml As String)
  HttpContext.Current.Response.Clear()
  HttpContext.Current.Response.Buffer = True
  HttpContext.Current.Response.Charset = "utf-8"
  Dim Filename As String = Typename + ".xls"
  HttpContext.Current.Response.AppendHeader("Content-Disposition", "online;filename=" + Filename)
  HttpContext.Current.Response.ContentEncoding = System.Text.Encoding.GetEncoding("utf-8")
  HttpContext.Current.Response.ContentType = "application/ms-excel"
  'this.EnableViewState = false;
  HttpContext.Current.Response.Write(TempHtml)
  HttpContext.Current.Response.End()
  End Sub 'GenerateByHtmlString
   
   
  '/ <summary>
  '/ 
  '/ </summary>
  '/ <param name="Typename"></param>
  '/ <param name="TempHtml"></param>
  Public Sub CreateExcelWithMode(TableRows As Integer, TableColumns As Integer, FileName As String)
  Dim TableString As String = ""
  TableString += TableStart(TableRows, TableColumns)
  TableString += s.ToString()
  TableString += TableEnd()
  Dim ModePath As String = HttpContext.Current.Server.MapPath("~/Refdll/ExcelMode.xml")
  Dim xmlDoc As New XmlDocument()
  xmlDoc.Load(ModePath)
  Dim ExcelXmlStr As String = xmlDoc.InnerXml
  ExcelXmlStr = ExcelXmlStr.Insert(ExcelXmlStr.IndexOf("</Worksheet>"), TableString)
  GenerateByHtmlString(FileName, ExcelXmlStr)
  End Sub 'CreateExcelWithMode
   
   
  '
  'ToDo: Error processing original source shown below
  '
  '
  '-----------^--- Pre-processor directives not translated
  Private Function TableStart(rows As Integer, columns As Integer) As String
  '
  'ToDo: Error processing original source shown below
  '
  '
  '--^--- Unexpected pre-processor directive
  Dim TableString As String = ""
  TableString += "<Table ss:ExpandedRowCount=""" + rows + """ ss:ExpandedColumnCount=""" + columns + """ x:FullColumns=""1"ControlChars.Lf
  TableString += "x:FullRows=""1"" ss:DefaultColumnWidth=""70"" ss:DefaultRowHeight=""14.25"">" + ControlChars.Lf
  Return TableString
  End Function 'TableStart
   
  Private Function TableEnd() As String
  Dim TableString As String = ""
  TableString += "</Table>" + ControlChars.Lf
  Return TableString
  End Function 'TableEnd
   
  Public Sub RowStart()
  s.Append("<Row ss:AutoFitHeight=""0"">" + ControlChars.Lf)
  End Sub 'RowStart
   
  Public Sub RowEnd()
  s.Append("</Row>" + ControlChars.Lf)
  End Sub 'RowEnd
   
  Public Sub CellWithoutFormula(DataType As String, Data As String)
  s.Append(("<Cell><Data ss:Type=""" + DataType + """>" + Data + "</Data></Cell>" + ControlChars.Lf))
  End Sub 'CellWithoutFormula
   
  Public Sub CellWithFormula(DataType As String, Formula As String)
  s.Append(("<Cell ss:Formula=""=" + Formula + """><Data ss:Type=""" + DataType + """></Data></Cell>" + ControlChars.Lf))
  End Sub 'CellWithFormula
End Class 'ExportExcel '
'ToDo: Error processing original source shown below
'
'
'-----------^--- Pre-processor directives not translated
'
'ToDo: Error processing original source shown below
'
'
'--^--- Unexpected pre-processor directive
 
  • 家说说Linq的缺点
#2楼 得分：20回复于：2007-12-05 14:35:46
VB.NET code
'把DataTable里的内容导出到EXCEL,执行代码就行,什么都不用改,什么都不用设置 Private   Sub   toExcel(ByVal   tb   As   DataTable)                 Dim   dgrid   As   System.Web.UI.WebControls.DataGrid   =   Nothing                 Dim   context   As   System.Web.HttpContext   =   System.Web.HttpContext.Current                 Dim   strOur   As   System.IO.StringWriter   =   Nothing                 Dim   htmlWriter   As   System.Web.UI.HtmlTextWriter   =   Nothing                 If   Not   IsNothing(tb)   Then                         context.Response.ContentType   =   "application/vnd.ms-excel "                         context.Response.ContentEncoding   =   System.Text.Encoding.UTF8                         context.Response.Charset   =   " "                         strOur   =   New   IO.StringWriter                         htmlWriter   =   New   System.Web.UI.HtmlTextWriter(strOur)                         dgrid   =   New   DataGrid                         dgrid.DataSource   =   tb.DefaultView                         dgrid.AllowPaging   =   False                         dgrid.DataBind()                         dgrid.RenderControl(htmlWriter)                         context.Response.Write(strOur.ToString)                         context.Response.End()                 End   If         End   Sub
 
[code=VB.NET][/code]
Imports Microsoft.Office.Interop

Try
  Dim xlApp As New Excel.Application
  Dim xlBook As Excel.Workbook
  xlBook = xlApp.Workbooks.Add(True)
  Dim rowIndex As Integer = 1
  Dim colIndex As Integer = 0

  For colIndex = 0 To DataGridView1.Columns.Count - 1
  xlApp.Cells(1, colIndex + 1) = DataGridView1.Columns(colIndex).HeaderCell.Value
  Next

  For rowIndex = 1 To DataGridView1.Rows.Count - 1
  For colIndex = 0 To DataGridView1.Columns.Count - 1
  xlApp.Cells(rowIndex + 1, colIndex + 1) = DataGridView1.Rows(rowIndex - 1).Cells(colIndex).Value.ToString
  Next
  Next
  xlApp.Visible = True

  xlBook = Nothing
  xlApp = Nothing
  Catch ex As Exception
  MsgBox("导出excle失败！" & ex.ToString().Trim(), MsgBoxStyle.Exclamation, "系统提示： ")

  End Try
 
  • 对我有用[0]
  • 丢个板砖[0]
  • 引用
  • 举报
  • 管理
  • TOP
精华推荐：如何做到让程序自学习，让程序有点思维呢
  • lunatic_0000用户头像
  • lunatic_0000
  • (疯。)
  • 等　级：
#6楼 得分：20回复于：2007-12-05 15:01:40
  • 对我有用[0]
  • 丢个板砖[0]
  • 引用
  • 举报
  • 管理
  • TOP
  • chenjl1031用户头像
  • chenjl1031
  • (东方之珠)
  • 等　级：

  • 5

    2

#7楼 得分：10回复于：2007-12-05 15:03:25
原创：魏滔序
博客：http://blog.csdn.net/Modest/archive/2007/07/30/1716649.aspx

'引入Excel的COM组件

Imports System
Imports System.Data
Imports System.Configuration
Imports System.Web
Imports System.Web.Security
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Web.UI.WebControls.WebParts
Imports System.Web.UI.HtmlControls
Imports Microsoft.Office.Interop
Imports Microsoft.Office.Core


Namespace ExcelEdit
 ''' <summary>
 ''' ExcelEdit 的摘要说明
 ''' </summary>
 Public Class ExcelEdit
  Public mFilename As String
  Public app As Excel.Application
  Public wbs As Excel.Workbooks
  Public wb As Excel.Workbook
  Public wss As Excel.Worksheets
  Public ws As Excel.Worksheet
  '
  ' TODO: 在此处添加构造函数逻辑
  '
  Public Sub New()
  End Sub
  Public Sub Create()
  '创建一个Excel对象
  app = New Excel.Application()
  wbs = app.Workbooks
  wb = wbs.Add(True)
  End Sub
  Public Sub Open(ByVal FileName As String)
  '打开一个Excel文件
  app = New Excel.Application()
  wbs = app.Workbooks
  wb = wbs.Add(FileName)
  'wb = wbs.Open(FileName, 0, true, 5,"", "", true, Excel.XlPlatform.xlWindows, "\t", false, false, 0, true,Type.Missing,Type.Missing);
  'wb = wbs.Open(FileName,Type.Missing,Type.Missing,Type.Missing,Type.Missing,Type.Missing,Type.Missing,Excel.XlPlatform.xlWindows,Type.Missing,Type.Missing,Type.Missing,Type.Missing,Type.Missing,Type.Missing,Type.Missing);
  mFilename = FileName
  End Sub
  Public Function GetSheet(ByVal SheetName As String) As Excel.Worksheet
  '获取一个工作表
  Dim s As Excel.Worksheet = DirectCast(wb.Worksheets(SheetName), Excel.Worksheet)
  Return s
  End Function
  Public Function AddSheet(ByVal SheetName As String) As Excel.Worksheet
  '添加一个工作表
  Dim s As Excel.Worksheet = DirectCast(wb.Worksheets.Add(Type.Missing, Type.Missing, Type.Missing, Type.Missing), Excel.Worksheet)
  s.Name = SheetName
  Return s
  End Function

  Public Sub DelSheet(ByVal SheetName As String)
  '删除一个工作表
  DirectCast(wb.Worksheets(SheetName), Excel.Worksheet).Delete()
  End Sub
  Public Function ReNameSheet(ByVal OldSheetName As String, ByVal NewSheetName As String) As Excel.Worksheet
  '重命名一个工作表一
  Dim s As Excel.Worksheet = DirectCast(wb.Worksheets(OldSheetName), Excel.Worksheet)
  s.Name = NewSheetName
  Return s
  End Function

  Public Function ReNameSheet(ByVal Sheet As Excel.Worksheet, ByVal NewSheetName As String) As Excel.Worksheet
  '重命名一个工作表二

  Sheet.Name = NewSheetName

  Return Sheet
  End Function

  Public Sub SetCellValue(ByVal ws As Excel.Worksheet, ByVal x As Integer, ByVal y As Integer, ByVal value As Object)
  'ws：要设值的工作表 X行Y列 value 值 
  ws.Cells(x, y) = value
  End Sub
  Public Sub SetCellValue(ByVal ws As String, ByVal x As Integer, ByVal y As Integer, ByVal value As Object)
  'ws：要设值的工作表的名称 X行Y列 value 值

  GetSheet(ws).Cells(x, y) = value
  End Sub

  Public Sub SetCellProperty(ByVal ws As Excel.Worksheet, ByVal Startx As Integer, ByVal Starty As Integer, ByVal Endx As Integer, ByVal Endy As Integer, ByVal size As Integer, _
  ByVal name As String, ByVal color As Excel.Constants, ByVal HorizontalAlignment As Excel.Constants)
  '设置一个单元格的属性 字体， 大小，颜色 ，对齐方式
  name = "宋体"
  size = 12
  color = Excel.Constants.xlAutomatic
  HorizontalAlignment = Excel.Constants.xlRight
  ws.get_Range(ws.Cells(Startx, Starty), ws.Cells(Endx, Endy)).Font.Name = name
  ws.get_Range(ws.Cells(Startx, Starty), ws.Cells(Endx, Endy)).Font.Size = size
  ws.get_Range(ws.Cells(Startx, Starty), ws.Cells(Endx, Endy)).Font.Color = color
  ws.get_Range(ws.Cells(Startx, Starty), ws.Cells(Endx, Endy)).HorizontalAlignment = HorizontalAlignment
  End Sub

  Public Sub SetCellProperty(ByVal wsn As String, ByVal Startx As Integer, ByVal Starty As Integer, ByVal Endx As Integer, ByVal Endy As Integer, ByVal size As Integer, _
  ByVal name As String, ByVal color As Excel.Constants, ByVal HorizontalAlignment As Excel.Constants)
  'name = "宋体";
  'size = 12;
  'color = Excel.Constants.xlAutomatic;
  'HorizontalAlignment = Excel.Constants.xlRight;

  Dim ws As Excel.Worksheet = GetSheet(wsn)
  ws.get_Range(ws.Cells(Startx, Starty), ws.Cells(Endx, Endy)).Font.Name = name
  ws.get_Range(ws.Cells(Startx, Starty), ws.Cells(Endx, Endy)).Font.Size = size
  ws.get_Range(ws.Cells(Startx, Starty), ws.Cells(Endx, Endy)).Font.Color = color

  ws.get_Range(ws.Cells(Startx, Starty), ws.Cells(Endx, Endy)).HorizontalAlignment = HorizontalAlignment
  End Sub


 
 
  • 对我有用[0]
  • 丢个板砖[0]
  • 引用
  • 举报
  • 管理
  • TOP
  • chenjl1031用户头像
  • chenjl1031
  • (东方之珠)
  • 等　级：

  • 5

    2

#8楼 得分：10回复于：2007-12-05 15:06:33
接上： 

Public Sub SetCellProperty(ByVal wsn As String, ByVal Startx As Integer, ByVal Starty As Integer, ByVal Endx As Integer, ByVal Endy As Integer, ByVal size As Integer, _
  ByVal name As String, ByVal color As Excel.Constants, ByVal HorizontalAlignment As Excel.Constants)
  'name = "宋体";
  'size = 12;
  'color = Excel.Constants.xlAutomatic;
  'HorizontalAlignment = Excel.Constants.xlRight;

  Dim ws As Excel.Worksheet = GetSheet(wsn)
  ws.get_Range(ws.Cells(Startx, Starty), ws.Cells(Endx, Endy)).Font.Name = name
  ws.get_Range(ws.Cells(Startx, Starty), ws.Cells(Endx, Endy)).Font.Size = size
  ws.get_Range(ws.Cells(Startx, Starty), ws.Cells(Endx, Endy)).Font.Color = color

  ws.get_Range(ws.Cells(Startx, Starty), ws.Cells(Endx, Endy)).HorizontalAlignment = HorizontalAlignment
  End Sub


  Public Sub UniteCells(ByVal ws As Excel.Worksheet, ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer)
  '合并单元格
  ws.get_Range(ws.Cells(x1, y1), ws.Cells(x2, y2)).Merge(Type.Missing)
  End Sub

  Public Sub UniteCells(ByVal ws As String, ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer)
  '合并单元格
  GetSheet(ws).get_Range(GetSheet(ws).Cells(x1, y1), GetSheet(ws).Cells(x2, y2)).Merge(Type.Missing)

  End Sub


  Public Sub InsertTable(ByVal dt As System.Data.DataTable, ByVal ws As String, ByVal startX As Integer, ByVal startY As Integer)
  '将内存中数据表格插入到Excel指定工作表的指定位置 为在使用模板时控制格式时使用一
  For i As Integer = 0 To dt.Rows.Count - 1

  For j As Integer = 0 To dt.Columns.Count - 1

  GetSheet(ws).Cells(startX + i, j + startY) = dt.Rows(i)(j).ToString()

  Next
  Next

  End Sub
  Public Sub InsertTable(ByVal dt As System.Data.DataTable, ByVal ws As Excel.Worksheet, ByVal startX As Integer, ByVal startY As Integer)
  '将内存中数据表格插入到Excel指定工作表的指定位置二
  For i As Integer = 0 To dt.Rows.Count - 1

  For j As Integer = 0 To dt.Columns.Count - 1


  ws.Cells(startX + i, j + startY) = dt.Rows(i)(j)

  Next
  Next

  End Sub


  Public Sub AddTable(ByVal dt As System.Data.DataTable, ByVal ws As String, ByVal startX As Integer, ByVal startY As Integer)
  '将内存中数据表格添加到Excel指定工作表的指定位置一
  For i As Integer = 0 To dt.Rows.Count - 1

  For j As Integer = 0 To dt.Columns.Count - 1


  GetSheet(ws).Cells(i + startX, j + startY) = dt.Rows(i)(j)

  Next
  Next

  End Sub
  Public Sub AddTable(ByVal dt As System.Data.DataTable, ByVal ws As Excel.Worksheet, ByVal startX As Integer, ByVal startY As Integer)
  '将内存中数据表格添加到Excel指定工作表的指定位置二
  For i As Integer = 0 To dt.Rows.Count - 1


  For j As Integer = 0 To dt.Columns.Count - 1


  ws.Cells(i + startX, j + startY) = dt.Rows(i)(j)
  Next
  Next

  End Sub
  Public Sub InsertPictures(ByVal Filename As String, ByVal ws As String)
  '插入图片操作一
  GetSheet(ws).Shapes.AddPicture(Filename, MsoTriState.msoFalse, MsoTriState.msoTrue, 10, 10, 150, _
  150)
  '后面的数字表示位置
  End Sub

  'public void InsertPictures(string Filename, string ws, int Height, int Width)//插入图片操作二
  '{
  ' GetSheet(ws).Shapes.AddPicture(Filename, MsoTriState.msoFalse, MsoTriState.msoTrue, 10, 10, 150, 150);
  ' GetSheet(ws).Shapes.get_Range(Type.Missing).Height = Height;
  ' GetSheet(ws).Shapes.get_Range(Type.Missing).Width = Width;
  '}
  'public void InsertPictures(string Filename, string ws, int left, int top, int Height, int Width)//插入图片操作三
  '{

  ' GetSheet(ws).Shapes.AddPicture(Filename, MsoTriState.msoFalse, MsoTriState.msoTrue, 10, 10, 150, 150);
  ' GetSheet(ws).Shapes.get_Range(Type.Missing).IncrementLeft(left);
  ' GetSheet(ws).Shapes.get_Range(Type.Missing).IncrementTop(top);
  ' GetSheet(ws).Shapes.get_Range(Type.Missing).Height = Height;
  ' GetSheet(ws).Shapes.get_Range(Type.Missing).Width = Width;
  '}
Public Sub InsertActiveChart(ByVal ChartType As Excel.XlChartType, ByVal ws As String, ByVal DataSourcesX1 As Integer, ByVal DataSourcesY1 As Integer, ByVal DataSourcesX2 As Integer, ByVal DataSourcesY2 As Integer, _
  ByVal ChartDataType As Excel.XlRowCol)
  '插入图表操作
  ChartDataType = Excel.XlRowCol.xlColumns
  wb.Charts.Add(Type.Missing, Type.Missing, Type.Missing, Type.Missing)
  wb.ActiveChart.ChartType = ChartType
  wb.ActiveChart.SetSourceData(GetSheet(ws).get_Range(GetSheet(ws).Cells(DataSourcesX1, DataSourcesY1), GetSheet(ws).Cells(DataSourcesX2, DataSourcesY2)), ChartDataType)
  wb.ActiveChart.Location(Excel.XlChartLocation.xlLocationAsObject, ws)
  End Sub
  Public Function Save() As Boolean
  '保存文档
  If mFilename = "" Then
  Return False
  Else
  Try
  wb.Save()
  Return True
  Catch ex As Exception

  Return False
  End Try
  End If
  End Function
  Public Function SaveAs(ByVal FileName As Object) As Boolean
  '文档另存为
  Try
  wb.SaveAs(FileName, Type.Missing, Type.Missing, Type.Missing, Type.Missing, Type.Missing, _
  Excel.XlSaveAsAccessMode.xlExclusive, Type.Missing, Type.Missing, Type.Missing, Type.Missing, Type.Missing)

  Return True
  Catch ex As Exception


  Return False
  End Try
  End Function
  Public Sub Close()
  '关闭一个Excel对象，销毁对象
  'wb.Save();
  wb.Close(Type.Missing, Type.Missing, Type.Missing)
  wbs.Close()
  app.Quit()
  wb = Nothing
  wbs = Nothing
  app = Nothing
  GC.Collect()
  End Sub
 End Class
End Namespace

 
  • 对我有用[0]
  • 丢个板砖[0]
  • 引用
  • 举报
  • 管理
  • TOP
  • jiezigege用户头像
  • jiezigege
  • (晴空笑脸)
  • 等　级：
#9楼 得分：0回复于：2007-12-06 09:51:30
谢谢各位,小弟自己也写了一个...
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Public Class Cls_Excel
  Private xlApp As Object
  Private xlBook As Object
  Private xlSheet As Object
  Public Sub New()
  xlApp = CreateObject("Excel.Application")
  End Sub
  Public Function AddBook(ByVal hStr_TemplateFile As String) As Boolean

  Dim Bln_Add As Boolean = False

  Try
  If System.IO.File.Exists(hStr_TemplateFile) = False Then

  Bln_Add = False

  ElseIf Microsoft.VisualBasic.StrConv(Right(hStr_TemplateFile, 3), VbStrConv.Lowercase) <> "xls" Then

  Bln_Add = False
  Else
  xlBook = xlApp.Workbooks.Open(hStr_TemplateFile)
  xlSheet = xlBook.Worksheets(1)
  Bln_Add = True
  End If
  Catch ex As Exception
  Finally
  End Try
  Return Bln_Add

  End Function

  Public Property Visible() As Boolean
  Get
  Return xlApp.Visible
  End Get
  Set(ByVal value As Boolean)
  xlApp.Visible = value
  End Set
  End Property
  '获取单一单元格
  Public Property Cells(ByVal hInt_Row As Integer, ByVal hInt_Col As Integer) As Object
  Get
  Return xlSheet.Cells(hInt_Row, hInt_Col)
  End Get
  Set(ByVal value As Object)
  xlSheet.Cells(hInt_Row, hInt_Col) = value
  End Set
  End Property
  '获取一组单元格
  Public Property Cells(ByVal hStr_RowCol As String) As Object
  Get
  Return xlSheet.Range(hStr_RowCol)
  End Get
  Set(ByVal value As Object)
  xlSheet.Range(hStr_RowCol) = value
  End Set
  End Property
  Public Sub Copy(ByVal hStr_Range_From As String, ByVal hStr_Range_End As String)
  xlSheet.Range(hStr_Range_From).Copy(xlSheet.Range(hStr_Range_End))
  End Sub
  Public Property SheetName() As Object
  Get
  Return xlSheet.Name
  End Get
  Set(ByVal value As Object)
  xlSheet.Name = value
  End Set
  End Property
  
End Class
 
  • 对我有用[0]
  • 丢个板砖[0]
  • 引用
  • 举报
  • 管理
  • TOP
  • SXYABC用户头像
  • SXYABC
  • (石头传)
  • 等　级：
#10楼 得分：0回复于：2007-12-08 09:00:19
小弟写的导出EXCEL代码:
  Dim app As New Excel.Application
  Dim b As Excel.Workbook = app.Workbooks.Add
  Dim s1 As Excel.Worksheet = b.Worksheets("sheet1")
  Dim ml As String
  Dim ml2 As String
  Dim colindex As Integer
  Dim rowindex As Integer
  Dim bb As String
  bb = FolderBrowserDialog1.ShowDialog()
  If bb = 1 Then
  ml = FolderBrowserDialog1.SelectedPath
  ml2 = ml & "\ERP即时库存"
  For colindex = 0 To DataGridView1.ColumnCount - 1
  s1.Cells(1, colindex + 1) = DataGridView1.Columns(colindex).HeaderCell.Value
  Next

  For rowindex = 1 To DataGridView1.Rows.Count - 1
  For colindex = 0 To DataGridView1.Columns.Count - 1
  s1.Cells(rowindex + 1, colindex + 1) = DataGridView1.Rows(rowindex - 1).Cells(colindex).Value.ToString
  Next
  Next
  b.SaveAs(ml2)
  b.Close()
  End If
 
  • 对我有用[0]
  • 丢个板砖[0]
  • 引用
  • 举报
  • 管理
  • TOP
  • try999用户头像
  • try999
  • (。。。。。。。。。。。)
  • 等　级：
#11楼 得分：10回复于：2007-12-09 09:36:39
public function daochu()  
Try

  dg_daochu.Caption = "<font size=3 color=blue>客户信息表</font>"
  HttpContext.Current.Response.Charset = "GB2312"
  Response.ContentEncoding = System.Text.Encoding.GetEncoding("GB2312")
  HttpContext.Current.Response.ContentType = "application/ms-excel"
  HttpContext.Current.Response.AppendHeader("Content-Disposition", "attachment;filename=customers.xls")
  dg_daochu.Page.EnableViewState = False
  Dim tw As System.IO.StringWriter = New System.IO.StringWriter
  Dim hw As System.Web.UI.HtmlTextWriter = New System.Web.UI.HtmlTextWriter(tw)
  dg_daochu.RenderControl(hw)
  HttpContext.Current.Response.Write(tw.ToString)
  HttpContext.Current.Response.End()

  Catch Ex As Exception

  End Try
end function
 
  • 对我有用[0]
  • 丢个板砖[0]
  • 引用
  • 举报
  • 管理
  • TOP
  • meilidexue用户头像
  • meilidexue
  • 等　级：
#12楼 得分：0回复于：2007-12-09 14:06:53
看花了!!
顶!
 
  • 对我有用[0]
  • 丢个板砖[0]
  • 引用
  • 举报
  • 管理
  • TOP
  • ou108用户头像
  • ou108
  • (低调,低调,一定要低调)
  • 等　级：
#13楼 得分：10回复于：2007-12-11 13:58:26
小数据导出还行,数据多了会慢

正常情况下应该把excel作为数据源操作,这样速度就不会慢

以下代码只需传Datatable和保存文件路径就OK

 Public Sub DtToXls(ByVal Table As DataTable, ByVal DefFileName As String)
  Dim MyOleDbCn As New System.Data.OleDb.OleDbConnection
  Dim MyOleDbCmd As New System.Data.OleDb.OleDbCommand
  Dim MyTable As New DataTable
  Dim intRowsCnt, intColsCnt As Integer
  Dim strSql As String, strFlName As String
  Dim Fso As New System.Object
  If Table Is Nothing Then
  MessageBox.Show("未取得數據，無法導出", "導出錯誤", MessageBoxButtons.OK, MessageBoxIcon.Error)
  Exit Sub
  End If
  MyTable = Table
  If MyTable.Rows.Count = 0 Then
  MessageBox.Show("未取得數據，無法導出", "導出錯誤", MessageBoxButtons.OK, MessageBoxIcon.Error)
  Exit Sub
  End If
  Dim FileName As String
  Dim SaveFileDialog As New SaveFileDialog
  SaveFileDialog.InitialDirectory = My.Computer.FileSystem.SpecialDirectories.MyDocuments
  SaveFileDialog.Title = "保存為"
  SaveFileDialog.Filter = ".xls|*.xls"
  SaveFileDialog.FileName = DefFileName
  If (SaveFileDialog.ShowDialog() = System.Windows.Forms.DialogResult.OK) Then
  FileName = SaveFileDialog.FileName
  ' TODO: 在此加入開啟檔案的程式碼。
  End If
  If FileName = "" Then Exit Sub
  strFlName = FileName
  If Dir(FileName) <> "" Then
  Kill(FileName)
  End If
  Try
  Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.WaitCursor

  MyOleDbCn.ConnectionString = "Provider=Microsoft.Jet.OleDb.4.0;" & _
  "Data Source=" & strFlName & ";" & _
  "Extended ProPerties=""Excel 8.0;HDR=Yes;"""
  MyOleDbCn.Open()
  MyOleDbCmd.Connection = MyOleDbCn
  MyOleDbCmd.CommandType = CommandType.Text

  '第一行插入列标题
  strSql = "CREATE TABLE " & DefFileName & "("
  For intColsCnt = 0 To MyTable.Columns.Count - 1
  If intColsCnt <> MyTable.Columns.Count - 1 Then
  strSql = strSql & ChangeChar(MyTable.Columns(intColsCnt).Caption) & " text,"
  Else
  strSql = strSql & ChangeChar(MyTable.Columns(intColsCnt).Caption) & " text)"
  End If
  Next
  MyOleDbCmd.CommandText = strSql
  MyOleDbCmd.ExecuteNonQuery()

  '插入各行
  For intRowsCnt = 0 To MyTable.Rows.Count - 1
  strSql = "INSERT INTO " & DefFileName & " VALUES('"
  For intColsCnt = 0 To MyTable.Columns.Count - 1
  If intColsCnt <> MyTable.Columns.Count - 1 Then
  strSql = strSql & ChangeChar(MyTable.Rows(intRowsCnt).Item(intColsCnt)) & "','"
  Else
  strSql = strSql & ChangeChar(MyTable.Rows(intRowsCnt).Item(intColsCnt)) & "')"
  End If
  Next
  MyOleDbCmd.CommandText = strSql
  MyOleDbCmd.ExecuteNonQuery()
  Next
  MessageBox.Show("数据已经成功导入EXCEL文件" & strFlName, "数据导出", MessageBoxButtons.OK, MessageBoxIcon.Information)
  Catch ErrCode As Exception
  MsgBox("错误信息：" & ErrCode.Message & vbCrLf & vbCrLf & _
  "引发事件：" & ErrCode.TargetSite.ToString, MsgBoxStyle.OkOnly + MsgBoxStyle.Information, "错误来源：" & ErrCode.Source)
  Exit Sub
  Finally
  MyOleDbCmd.Dispose()
  MyOleDbCn.Close()
  MyOleDbCn.Dispose()
  'Me.Cursor.Current = System.Windows.Forms.Cursors.Default
  End Try

  End Sub

  Public Function ChangeChar(ByVal Sqlchar) As String

  If Convert.IsDBNull(Sqlchar) Then
  ChangeChar = " "
  Exit Function
  End If
  Dim tStr As String
  tStr = Replace(Sqlchar, "'", Chr(39) + Chr(39))
  tStr = Replace(tStr, "|", "_")
  ChangeChar = tStr
  End Function
玩王者荣耀网络延迟高 玩王者荣耀网络延迟高
原创粉丝点击
热门IT博客
泡利矩阵泡利矩阵
js 二维数组 keyjs 二维数组 key
nginx php exec su
淘宝商城丝巾
淘宝网网店
linux 对文件进行排序
别哭妈妈图解知乎
windows系统发展史
兰西美工招聘
淘宝欧洲站衣服怎么样
网络公安举报
c 如何给布尔型数组
易幻网络
小米网络音响vs潘多拉
我的世界登入器源码
淘宝无线链接在线转换
windows开机启动文件
会计kk软件下载
苹果群发短信软件下载
php运行环境搭建
热门问题 老师的惩罚 人脸识别 我在镇武司摸鱼那些年 重生之率土为王 我在大康的咸鱼生活 盘龙之生命进化 天生仙种 凡人之先天五行 春回大明朝 姑娘不必设防，我是瞎子 帜怎么组词 厮组词 蕴组词 隅组词 帝一酒多少钱一瓶 帝一酒 三国之无双武帝 三国之赤帝 三国之献帝崛起 三国之帝临诸天 网游三国之无双武帝 九命 少夷君 乐帝仕充电宝怎么样 qq飞车帝企鹅技能 帝企鹅图片 钢帝企鹅配招 帝企鹅日记2下载 帝企鹅日记国语版 纪录片 帝企鹅 帝企鹅日记下载 帝企鹅品牌 qq飞车帝企鹅进化图 帝企鹅的习性 帝企鹅红酒 帝企鹅日记2 帝企鹅的图片 帝企鹅的特点 气温升高导致半数帝企鹅死亡 帝少蜜宠令休妻休想逃 韩国蒂佳婷面膜好用吗 保罗盖帝鞋子怎么样 保罗盖帝旗舰店 圣帝保罗洁具 八十路帝冢真织在线播放 帝冢真织高清中文字幕 萧清帝苏若颜 沐安颜帝翎寒 萧青帝都市隐龙 萧青帝苏若颜 君慕颜帝溟诀 九幽荒帝 泪空颜 都市隐龙萧青帝苏若颜

程序博客网，程序员的互联网技术博客家园。csdn论坛精品 msdn技术资料都在这里