Chinaunix首页 | 论坛 | 博客
  • 博客访问: 475098
  • 博文数量: 112
  • 博客积分: 5696
  • 博客等级: 大校
  • 技术积分: 1720
  • 用 户 组: 普通用户
  • 注册时间: 2007-08-17 09:58
文章分类

全部博文(112)

文章存档

2011年(22)

2010年(28)

2009年(21)

2008年(41)

分类:

2008-04-02 11:32:35

    '列宽默认为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

阅读(758) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~