一个通用的Datagrid导出Excel打印的源函数
''Power by:Landlordh
''列宽默认为datagird的tablestyles(0)列宽的五分之一
''G2E(dg1)
Public Function G2E(ByVal dg As DataGrid)
Dim dt As New DataTable
Try
dt = CType(dg.DataSource, DataTable)
Catch ex As Exception
MsgBox(ex.Message)
Exit Function
End Try
Dim total_col As Integer = dt.Columns.Count
Dim total_row As Integer = dt.Rows.Count
If total_col < 1 Or total_row < 1 Then
MsgBox("没有可供导入的数据!", MsgBoxStyle.Information, "系统提示")
Exit Function
End If
''killEXCEL()
''要先在引用中添加EXCEL组件
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Try
GC.Collect()
xlBook = xlApp.Workbooks().Add
xlSheet = xlBook.Worksheets("sheet1")
xlApp.Visible = True
Try
With xlSheet.PageSetup
.RightMargin = 1
.LeftMargin = 1
.CenterHorizontally = True
.CenterHeader = "&24 报表"
.RightFooter = "&P of &N"
End With
Catch ex As Exception
MsgBox(ex.ToString)
Exit Function
End Try
Dim Col As Integer
Dim Row As Integer
Dim st_row As Integer = 5 ''数据列头开始行,(列头)
Dim trueCol As Integer = 0
For Col = 0 To total_col - 1
If dg.TableStyles.Item(0).GridColumnStyles.Item(Col).Width > 0 Then trueCol += 1
Next
Dim TitleArray(4, 0) As Object
Dim HeaderArray(0, trueCol - 1) As Object
Dim DataArray(total_row - 1, trueCol - 1) As Object
TitleArray(0, 0) = "TO:"
TitleArray(1, 0) = "FORM:"
TitleArray(2, 0) = ""
TitleArray(3, 0) = ""
xlSheet.Range("A1").Resize(4, 1).Value = TitleArray
Dim i As Integer = 0
For Col = 0 To total_col - 1
If dg.TableStyles.Item(0).GridColumnStyles.Item(Col).Width > 0 Then
i += 1
HeaderArray(0, i - 1) = dt.Columns(Col).ColumnName
''设列宽,默认为datagird列宽的五分之一
xlSheet.Cells(st_row, i).ColumnWidth = dg.TableStyles.Item(0).GridColumnStyles.Item(Col).Width / 5
End If
Next
xlSheet.Range("A" & st_row).Resize(st_row, trueCol).Value = HeaderArray
For Row = 0 To total_row - 1
i = 0
For Col = 0 To total_col - 1
If dg.TableStyles.Item(0).GridColumnStyles.Item(Col).Width > 0 Then
i += 1
DataArray(Row, i - 1) = dt.Rows(Row).Item(Col)
End If
Next
Next
xlSheet.Range("A" & st_row + 1).Resize(total_row, trueCol).Value = DataArray
With xlSheet
.Range(.Cells(st_row, 1), .Cells(st_row, trueCol)).Font.Bold = True
.Range(.Cells(st_row, 1), .Cells(st_row, trueCol)).HorizontalAlignment = 3
.Range(.Cells(st_row, 1), .Cells(total_row + st_row, trueCol)).Borders.LineStyle = 1
''设置数据区第一列到第二列为居中
.Range(.Cells(st_row, 1), .Cells(total_row + st_row, 2)).HorizontalAlignment = 3
End With
xlApp.ActiveWorkbook.PrintPreview()
Catch ex As Exception
xlSheet = Nothing
xlApp.DisplayAlerts = False
xlBook.RunAutoMacros(Excel.XlRunAutoMacro.xlAutoClose)
xlBook.Close()
xlBook = Nothing
xlApp.Quit()
xlApp.DisplayAlerts = True
xlApp = Nothing
GC.Collect()
MsgBox(ex.ToString)
Exit Function
End Try
xlSheet = Nothing
xlApp.DisplayAlerts = False
xlBook.RunAutoMacros(Excel.XlRunAutoMacro.xlAutoClose)
xlBook.Close()
xlBook = Nothing
xlApp.Quit()
xlApp.DisplayAlerts = True
xlApp = Nothing
GC.Collect()
End Function
''Power by:Landlordh
''列宽默认为datagird的tablestyles(0)列宽的五分之一
''G2E(dg1)
Public Function G2E(ByVal dg As DataGrid)
Dim dt As New DataTable
Try
dt = CType(dg.DataSource, DataTable)
Catch ex As Exception
MsgBox(ex.Message)
Exit Function
End Try
Dim total_col As Integer = dt.Columns.Count
Dim total_row As Integer = dt.Rows.Count
If total_col < 1 Or total_row < 1 Then
MsgBox("没有可供导入的数据!", MsgBoxStyle.Information, "系统提示")
Exit Function
End If
''killEXCEL()
''要先在引用中添加EXCEL组件
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Try
GC.Collect()
xlBook = xlApp.Workbooks().Add
xlSheet = xlBook.Worksheets("sheet1")
xlApp.Visible = True
Try
With xlSheet.PageSetup
.RightMargin = 1
.LeftMargin = 1
.CenterHorizontally = True
.CenterHeader = "&24 报表"
.RightFooter = "&P of &N"
End With
Catch ex As Exception
MsgBox(ex.ToString)
Exit Function
End Try
Dim Col As Integer
Dim Row As Integer
Dim st_row As Integer = 5 ''数据列头开始行,(列头)
Dim trueCol As Integer = 0
For Col = 0 To total_col - 1
If dg.TableStyles.Item(0).GridColumnStyles.Item(Col).Width > 0 Then trueCol += 1
Next
Dim TitleArray(4, 0) As Object
Dim HeaderArray(0, trueCol - 1) As Object
Dim DataArray(total_row - 1, trueCol - 1) As Object
TitleArray(0, 0) = "TO:"
TitleArray(1, 0) = "FORM:"
TitleArray(2, 0) = ""
TitleArray(3, 0) = ""
xlSheet.Range("A1").Resize(4, 1).Value = TitleArray
Dim i As Integer = 0
For Col = 0 To total_col - 1
If dg.TableStyles.Item(0).GridColumnStyles.Item(Col).Width > 0 Then
i += 1
HeaderArray(0, i - 1) = dt.Columns(Col).ColumnName
''设列宽,默认为datagird列宽的五分之一
xlSheet.Cells(st_row, i).ColumnWidth = dg.TableStyles.Item(0).GridColumnStyles.Item(Col).Width / 5
End If
Next
xlSheet.Range("A" & st_row).Resize(st_row, trueCol).Value = HeaderArray
For Row = 0 To total_row - 1
i = 0
For Col = 0 To total_col - 1
If dg.TableStyles.Item(0).GridColumnStyles.Item(Col).Width > 0 Then
i += 1
DataArray(Row, i - 1) = dt.Rows(Row).Item(Col)
End If
Next
Next
xlSheet.Range("A" & st_row + 1).Resize(total_row, trueCol).Value = DataArray
With xlSheet
.Range(.Cells(st_row, 1), .Cells(st_row, trueCol)).Font.Bold = True
.Range(.Cells(st_row, 1), .Cells(st_row, trueCol)).HorizontalAlignment = 3
.Range(.Cells(st_row, 1), .Cells(total_row + st_row, trueCol)).Borders.LineStyle = 1
''设置数据区第一列到第二列为居中
.Range(.Cells(st_row, 1), .Cells(total_row + st_row, 2)).HorizontalAlignment = 3
End With
xlApp.ActiveWorkbook.PrintPreview()
Catch ex As Exception
xlSheet = Nothing
xlApp.DisplayAlerts = False
xlBook.RunAutoMacros(Excel.XlRunAutoMacro.xlAutoClose)
xlBook.Close()
xlBook = Nothing
xlApp.Quit()
xlApp.DisplayAlerts = True
xlApp = Nothing
GC.Collect()
MsgBox(ex.ToString)
Exit Function
End Try
xlSheet = Nothing
xlApp.DisplayAlerts = False
xlBook.RunAutoMacros(Excel.XlRunAutoMacro.xlAutoClose)
xlBook.Close()
xlBook = Nothing
xlApp.Quit()
xlApp.DisplayAlerts = True
xlApp = Nothing
GC.Collect()
End Function