首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > .NET > VB Dotnet >

B/S结构下用vb.net怎样将Datagrid中的数据导出到excel中?(在线急等)解决方法

2012-02-27 
B/S结构下用vb.net怎样将Datagrid中的数据导出到excel中?(在线急等)小弟在B/S结构下想通过一个按钮实现dat

B/S结构下用vb.net怎样将Datagrid中的数据导出到excel中?(在线急等)
小弟在B/S结构下想通过一个按钮实现datagrid中数据的导出,不知有源码否?我用的是vb.net开发的程序,在线急等!!!!

[解决办法]
我可是研究了半个多月当初才写出来的
可以直接使用
Sub PrintData(ByVal sqlstr As String, ByVal FID As Integer)
Dim I As Integer
Dim myTable As New DataTable
Try
myTable = DataAccess.GetDataTableBySearch(sqlstr & FID)
Catch ex As Exception
myTable.Rows.Clear()
End Try
If myTable.Columns.Count <= 0 Then Exit Sub
Dim intStr As Integer = 0

Dim RBArr() As String = { "Code ", "MaterialID ", "Totality ", "TransactFlag ", "IDDetailsID ", "InDepotID ", "ConsultTable ", "ConsultIDName ", "ConsultID ", "DepotName "}

For I = 0 To RBArr.GetUpperBound(0)
myTable.Columns.Remove(RBArr(I))
Next

Dim TempName As String
Dim myExcel As New Excel.Application
Dim myBooks As Excel.Workbooks, myBook As Excel.Workbook
Dim mySheets As Excel.Sheets, mySheet As Excel.Worksheet
Dim myFile As String, myTemplate As String
TempName = "入库单列表 " + System.DateTime.Now.ToString( "yyyyMMddHHmm ") + ".xls "
myFile = Server.MapPath(Request.ApplicationPath + "/thmrpTempFile/ ") & TempName
myTemplate = Server.MapPath(Request.ApplicationPath + "/ExcelTemplate/入库单列表模板.xls ")

myExcel.Visible = False
myExcel.DisplayAlerts = False
myBooks = myExcel.Workbooks
myBooks.Open(myTemplate)
myBook = myBooks.Item(1)
mySheets = myBook.Worksheets
mySheet = CType(mySheets.Item(1), Excel.Worksheet)
mySheet.Name = "入库单列表 "
Call Me.ClearTempFile()
Session( "tempFilePath ") = myFile.Trim

intStr = ExportDumpData(myTable, mySheet) '调用过程填充数据

sqlstr = "select e.PointName,F.UserName,e.LogDate From (select b.PointName,a.TransactUser,a.LogDate,a.Idea from (select * from StockInDepotLogVIEW where TableID = " & FID & " ) as a left join (select * from Sys_BillFlow where BillId = 7) as b ON a.FlowRolesID = b.BillFlowId) as e left Join Sys_UserInfo as F on e.TransactUser = f.UserId "
Try
myTable = DataAccess.GetDataTableBySearch(sqlstr)
Catch ex As Exception
Exit Try
End Try
If myTable.Rows.Count > 0 And intStr > 0 Then
ExportDumpFlow(myTable, mySheet, intStr)
End If

Try
mySheet.SaveAs(myFile) '另存excel文件
myBook.Close()
Catch ex As Exception
Exit Sub
Finally
System.GC.Collect()
myExcel.Quit()
End Try

Dim myStr As String = " "
Dim openWinStrBud As New System.Text.StringBuilder( " ")
TempName = "/thmrpTempFile/ " & TempName
openWinStrBud.Append( "File:///// ")
openWinStrBud.Append(Page.Server.MachineName)
openWinStrBud.Append(TempName)
myStr = " <script language=javascript> try{var wsh = new ActiveXObject( 'WScript.Shell ');wsh.Run( ' " & openWinStrBud.ToString & " ');}catch(e){alert( '对不起,不能打开文件,请将Internet Explorer 浏览器的安全级别设置为低! ');} </script> "

If myStr.Trim.Length > 0 Then


Message.Text = myStr
End If
openWinStrBud.Replace(openWinStrBud.ToString, " ")
End Sub

Private Function ExportDumpData(ByVal myTable As DataTable, ByVal mySheet As Object) As Integer
'填充数据
Dim dr As DataRow
Dim rowNum As Integer
Dim Irow As Integer
Dim moneyCount As Double = 0.0
Dim CountNum As Double = 0.0

rowNum = 2
For Irow = 0 To myTable.Rows.Count - 1
dr = myTable.Rows.Item(Irow)
mySheet.Cells(rowNum, 8) = lblNo.Text.Substring(3, lblNo.Text.Length - 3)

Next
rowNum = 3
For Irow = 0 To myTable.Rows.Count - 1
dr = myTable.Rows.Item(Irow)
mySheet.Cells(rowNum, 3) = lblDate.Text
mySheet.Cells(rowNum, 8) = txtInvoiceNO.Text
Next

rowNum = 4
For Irow = 0 To myTable.Rows.Count - 1
dr = myTable.Rows.Item(Irow)
rowNum = rowNum + 1
mySheet.Cells(rowNum, 1) = (Irow + 1).ToString.Trim()
mySheet.Cells(rowNum, 2) = dr(0).ToString.PadRight(12) '材料名称
mySheet.Cells(rowNum, 3) = dr(1).ToString.Trim() '规格型号
mySheet.Cells(rowNum, 4) = dr(2).ToString.Trim() '单位
mySheet.Cells(rowNum, 5) = dr(7).ToString.Trim() '数量
mySheet.Cells(rowNum, 6) = "¥ " & Format(Val(dr(8)), "0.00 ").ToString.Trim '单价
mySheet.Cells(rowNum, 7) = "¥ " & Format(Val(dr(9)), "0.00 ").ToString.Trim '金额
mySheet.Cells(rowNum, 8) = dr(10).ToString.Trim() '备注

moneyCount = moneyCount + Val(dr(9))
CountNum = CountNum + Val(dr(7))
Next
rowNum = rowNum + 1
mySheet.cells(rowNum, 1) = "合计 "
mySheet.cells(rowNum, 7) = "¥ " & Format(moneyCount, "0.00 ").ToString.Trim
mySheet.Cells(rowNum, 5) = Format(CountNum, "0.00 ").ToString.Trim

mySheet.Range(mySheet.Cells(4, 1), mySheet.Cells(rowNum, 8)).Borders.LineStyle = 1
Return rowNum
End Function
Private Sub ExportDumpFlow(ByVal subDt As DataTable, ByVal mysheet As Object, ByVal rowNum As Integer)
Dim dr As DataRow
Dim col_num As Integer
Dim iRow, iCol As Integer
For iRow = 0 To subDt.Rows.Count - 1
rowNum = rowNum + 1
col_num = 1
dr = subDt.Rows.Item(iRow)
For iCol = 0 To subDt.Columns.Count - 1
If iCol = 0 Then
mysheet.cells(rowNum, col_num) = dr.Item(iCol).ToString.Trim & ": "
Else
mysheet.cells(rowNum, col_num) = dr.Item(iCol).ToString.Trim
End If
col_num = col_num + 1
Next
Next
End Sub
Private Sub ClearTempFile()
Try
Dim FilePath As String
FilePath = Session( "tempFilePath ")
If (FilePath.Trim.Length > 0) And (Dir(FilePath).Trim.Length > 0) Then
File.Delete(FilePath)
End If
Catch ex As Exception
Exit Sub
End Try
End Sub
[解决办法]
Public Sub DsToExcel(ByVal ds As DataSet, ByVal SaveDl As SaveFileDialog)
Dim strFlName As String
With SaveDl
.Title = "請選擇要匯出的csv文件名 "


.Filter = "Excel文件(*.xls)|*.xls "
.FileName = " "
End With
If SaveDl.ShowDialog = Windows.Forms.DialogResult.OK Then
If SaveDl.FileName <> " " Then
strFlName = SaveDl.FileName()
Else
Exit Sub
End If
Else
Exit Sub
End If
Dim fs As FileStream = New FileStream(strFlName, FileMode.Create, FileAccess.Write)
Dim sw As StreamWriter = New StreamWriter(fs, System.Text.Encoding.GetEncoding( "BIG5 "))
Dim ColName As String = " ", RowName As String = " "

Dim Col As DataColumn
Dim Row As DataRow
For Each Col In ds.Tables(0).Columns
ColName = ColName + Col.ColumnName + vbTab
Next
sw.WriteLine(ColName)
For Each Row In ds.Tables(0).Rows
For Each Col In ds.Tables(0).Columns
RowName = RowName + Replace(Row(Col.ColumnName).ToString, ", ", " ") + vbTab
'如果是c# ,vbTab 改為 \t
Next
sw.WriteLine(RowName)
RowName = " "
Next
sw.Close()
MessageBox.Show( "數據已經成功導入EXCEL文件 " & strFlName, "數據導出 ", MessageBoxButtons.OK, MessageBoxIcon.Information)
End Sub

热点排行