2011年11月23日 星期三

asp.net 匯出 Excel檔案 (*.xls)

設定方法如這裡(轉載)

http://www.dotblogs.com.tw/finalevil/archive/2008/09/28/5517.aspx

製造方法
   '''
    ''' 製造Excel函數
    '''

    ''' 第幾個資料表
    ''' 內容
    ''' 名稱
    ''' 結束? 
    ''' 成功回傳True ,失敗回傳False
    '''
    Public Function GenerateExcel(ByVal contain_DT As System.Data.DataTable, ByVal strSheetName As String, ByVal intNumber As Integer, ByVal bolEnd As Boolean)
        If contain_DT.Rows.Count = 0 Then
            'Return False
        End If
        '
        '
        'xlApp.Visible = False
        Dim intColumn, intRowCount As Integer
        Dim Ii, Jj As Integer
        Dim strColumn As String
        'Dim strPath As String

        'strPath = PUB_LIB.QueryFirstRec("SELECT Remark FROM Config_m WHERE [con_kind]='EXCEL' ")

        intColumn = contain_DT.Columns.Count
        intRowCount = contain_DT.Rows.Count '- 1
        'xlApp.Visible = True
        '增加一個資料,是『資料比數:XX筆』這樣
        contain_DT.Rows.Add()
        contain_DT.Rows(contain_DT.Rows.Count - 1).Item(0) = "資料筆數:"
        contain_DT.Rows(contain_DT.Rows.Count - 1).Item(1) = intRowCount & "筆"
        Select Case contain_DT.Columns.Count
            Case 1
                strColumn = "A"
            Case 2
                strColumn = "B"
            Case 3
                strColumn = "C"
            Case 4
                strColumn = "D"
            Case 5
                strColumn = "E"
            Case 6
                strColumn = "F"
            Case 7
                strColumn = "G"
            Case 8
                strColumn = "H"
            Case 9
                strColumn = "I"
            Case 10
                strColumn = "J"
            Case 11
                strColumn = "K"
            Case 12
                strColumn = "L"
            Case 13
                strColumn = "M"
            Case 14
                strColumn = "N"
            Case 15
                strColumn = "O"
            Case 16
                strColumn = "P"
            Case 17
                strColumn = "Q"
            Case 18
                strColumn = "R"
            Case 19
                strColumn = "S"
            Case 20
                strColumn = "T"
            Case 21
                strColumn = "U"
            Case 22
                strColumn = "V"
            Case 23
                strColumn = "W"
            Case 24
                strColumn = "X"
            Case 25
                strColumn = "Y"
            Case 26
                strColumn = "Z"
            Case 27
                strColumn = "AA"
            Case 28
                strColumn = "AB"
            Case 29
                strColumn = "AC"
            Case 30
                strColumn = "AD"
            Case 31
                strColumn = "AE"
            Case 32
                strColumn = "AF"
            Case Else
                Return False
        End Select
        'Get the current locale, for later use
        Dim current_culture_info As System.Globalization.CultureInfo = _
        System.Threading.Thread.CurrentThread.CurrentCulture
        'Set locale to English-US
        System.Threading.Thread.CurrentThread.CurrentCulture = _
        New System.Globalization.CultureInfo("ZH-TW")
        '
        'Mainpulate the excel elements
        If xlBook.Worksheets.Count < intNumber Then
            xlBook.Worksheets.Add()
            intNumber = 1
        End If
        Dim ExlSheet As Excel.Worksheet '= xlBook.NewSheet
        ExlSheet = CType(xlBook.Worksheets(intNumber), Excel.Worksheet)
        ExlSheet.Name = strSheetName
        '改變值
        'xlBook.Sheets(1).cells(1, 1) = strTitle
        'xlBook.Sheets(1).cells(1, 1).Font.Size = 16
        'xlBook.Sheets(1).cells(1, 1).Font.Bold = True
        'xlBook.Sheets(1).Range("A1", strColumn & "1").Merge()
        'xlBook.Sheets(1).cells(1, 1).HorizontalAlignment = Microsoft.Office.Interop.Excel.Constants.xlCenter
        For Ii = 1 To contain_DT.Columns.Count
            ExlSheet.Cells(1, Ii) = "'" & contain_DT.Columns(Ii - 1).ColumnName
            'xlBook.Sheets(1).cells(2, Ii).Columns.AutoFit()
            ExlSheet.Cells(1, Ii).Font.Size = 12
            ExlSheet.Cells(1, Ii).Font.Color = RGB(255, 255, 255)
            ExlSheet.Cells(1, Ii).Font.Bold = True
            'ExlSheet.Cells(1, Ii).BorderAround(1, XlBorderWeight.xlThin, 3)
            ExlSheet.Cells(1, Ii).Interior.Color = RGB(79, 148, 205)
        Next
        'xlBook.Sheets(1).Range("A2", "E2").Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeTop).LineStyle = Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous
        'xlBook.Sheets(1).Range("A2", "E2").Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeTop).Color = Color.Blue.ToArgb
        'xlBook.Sheets(1).Range("A2", "E2").Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous
        'xlBook.Sheets(1).Range("A2", "E2").Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeBottom).Color = Color.Blue.ToArgb
        'xlBook.Sheets(xlBook.Sheets.Count - 1).Range("A2", strColumn & "2").Interior.ColorIndex = 5
        For Ii = 0 To contain_DT.Rows.Count - 1
        
            For Jj = 0 To contain_DT.Columns.Count - 1
                ExlSheet.Cells(Ii + 2, Jj + 1) = "'" & contain_DT.Rows(Ii).Item(Jj).ToString
                'xlBook.Sheets(1).cells(Ii + 1 + 2, Jj + 1).Columns.AutoFit()
                'ExlSheet.Cells(Ii + 2, Jj + 1).BorderAround(1, XlBorderWeight.xlThin, 3)
                'xlBook.Sheets(1).cells(Ii + 1 + 2, Jj + 1).Border.style.color = Color.Red.ToArgb
                'xlBook.Sheets(1).cells(Ii + 1 + 2, Jj + 1).Borders(Microsoft.Office.Interop.Excel.XlBarShape.xlBox).Color = Color.Blue.ToArgb
                If (Ii Mod 2) = 0 Then
                    ExlSheet.Cells(Ii + 2, Jj + 1).Interior.Color = RGB(255, 255, 224)
                End If
            Next
        Next

        ExlSheet.Columns.AutoFit()
        'xlBook.Sheets(1).Range("A2", "A2").Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeLeft).LineStyle = Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous
        'xlBook.Sheets(1).Range("A2", "A2").Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeLeft).Color = Color.Blue.ToArgb
        'xlBook.Sheets(1).Range("E2", "E2").Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeRight).LineStyle = Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous
        'xlBook.Sheets(1).Range("E2", "E2").Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeRight).Color = Color.Blue.ToArgb

        'xlBook.Sheets(1).cells(2, 2) = 555
        ''改變顏色
        'xlBook.Sheets(1).Range("A1", "D1").Interior.ColorIndex = 4
        ''框線
        'xlBook.Sheets(1).Range("A2", "D2").Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeTop).LineStyle = Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous
        'xlBook.Sheets(1).Range("A2", "D2").Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeTop).Color = Color.Blue.ToArgb
        'xlBook.Sheets(1).Range("A2", "D2").Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous
        'xlBook.Sheets(1).Range("A2", "D2").Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeBottom).Color = Color.Blue.ToArgb
        'xlBook.Sheets(1).Range("A2", "A2").Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeLeft).LineStyle = Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous
        'xlBook.Sheets(1).Range("A2", "A2").Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeLeft).Color = Color.Blue.ToArgb
        'xlBook.Sheets(1).Range("D2", "D2").Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeRight).LineStyle = Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous
        'xlBook.Sheets(1).Range("D2", "D2").Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeRight).Color = Color.Blue.ToArgb
        ''合併
        'xlBook.Sheets(1).cells(3, 1) = "合併"
        'xlBook.Sheets(1).Range("A3", "D3").Merge()
        ''置中
        '
        ''改變字體
        'xlBook.Sheets(1).cells(3, 1).Font.Size = 16
        ''粗體
        ''改變字的顏色
        'xlBook.Sheets(1).cells(3, 1).Font.Color = Color.Red.ToArgb
        'xlBook.Save()
        'Set the locale back to what it used to be

        System.Threading.Thread.CurrentThread.CurrentCulture = _
        current_culture_info
        'xlBook.Sheets.Add(ExlSheet)
        'xlApp.PageSetup.Orientation = XlPageOrientation.xlLandscape
        'xlBook.PageSetup.Orientation = Microsoft.Office.Interop.Excel.XlPageOrientation.xlLandscape

        xlApp.Visible = False
        If bolEnd Then
            Try
                If My.Computer.FileSystem.FileExists(AppSettings("tempFileFolder") & ddlDate.SelectedValue & ".xls") Then
                    My.Computer.FileSystem.DeleteFile(AppSettings("tempFileFolder") & ddlDate.SelectedValue & ".xls")
                End If
                xlApp.Workbooks(1).SaveAs(AppSettings("tempFileFolder") & ddlDate.SelectedValue & ".xls" _
                , Microsoft.Office.Interop.Excel.XlFileFormat.xlExcel5)
                xlBook.Close()
            Catch ex As Exception
                clsPulic.ShowAlertMessage(Me.Page, ex.Message)
            End Try
            xlApp.Workbooks.Close()
            xlApp.Quit()
        End If

        Return True
    End Function


下載方法

  Private Sub DownLoadFile(ByVal parFilePath As String)
        '將虛擬路徑轉換成實體路徑
        Dim strFilePath As String = AppSettings("tempFileFolder") ' Server.MapPath(parFilePath)
        If strFilePath.Split("\").Length <> 0 Then
            Dim FileName As String = parFilePath.Split("/")(parFilePath.Split("/").Length - 1)
            '中文檔名作轉換
            FileName = HttpUtility.UrlEncode(FileName, Encoding.UTF8)
            Dim fr As FileStream = New FileStream(strFilePath & FileName, FileMode.Open)
            Dim buf(fr.Length) As Byte '= New Byte()
            fr.Read(buf, 0, Convert.ToInt32(fr.Length))
            fr.Close()
            fr.Dispose()
            Response.Clear()
            Response.ClearHeaders()
            Response.Buffer = True
            '轉換文字檔編碼格式用,但本次輸出無文字檔,故註解此段
            'Response.ContentEncoding =
            Response.AddHeader("content-disposition", "attachment; filename=" & FileName)
            Response.BinaryWrite(buf)
            Response.End()
        End If
    End Sub