VB2005水晶报表导出问题

[DQHYATOU]

用水晶报表自带的 导出功能，DATESET做的数据源 ，导出WORD没问题 导出EXCEL就提示内存不足够完成此处操作 没 任何多余代码 最简单的打印.......请高手

[DQHYATOU]

代码:
未完成代码：
Public Class Forrpt1

Private Sub CrystalReportViewer1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CrystalReportViewer1.Load

CrystalReportViewer1.DisplayBackgroundEdge = True '确定报表是否超出窗口边缘
CrystalReportViewer1.DisplayGroupTree = False '确定树视图是否可见
CrystalReportViewer1.DisplayToolbar = True '工具栏
CrystalReportViewer1.ShowCloseButton = True '关闭
CrystalReportViewer1.ShowExportButton = False '导出
CrystalReportViewer1.ShowGotoPageButton = True '指定页码按钮
CrystalReportViewer1.ShowGroupTreeButton = False '显示/隐藏组树按钮
CrystalReportViewer1.ShowPageNavigateButtons = True '翻页按钮
CrystalReportViewer1.ShowPrintButton = True '打印
CrystalReportViewer1.ShowRefreshButton = False '刷新
CrystalReportViewer1.ShowTextSearchButton = False '搜索
CrystalReportViewer1.ShowZoomButton = True '比例缩放
CrystalReportViewer1.Refresh() '重绘控件
CrystalReportViewer1.ReportSource = Application.StartupPath & "\baobiao\Report.rpt" '按报表名称绑定报表

' CrystalReportViewer1.RefreshReport() '刷新报表
End Sub
End Class


数据源是 数据库中拉的一个小表(不是动态提供的)

[解释多余的]

帮顶!

[水猿兵团五哥]

LZ贴的代码干什么用？
是不会把表中的内容写到EXCEL中么？
先查找数据啊，然后把数据贴进EXCEL就好了啊

Dim s As New System.Text.StringBuilder
'Dim IA As Integer
'Dim SW As Boolean

s.Append(" select A.CODE,B.NAME,A.HOKAN,SUM(A.JITU0) ,A.IDATE ")
s.Append(" FROM XRACT AS A")
s.Append(" INNER JOIN XHEAD AS B")
s.Append(" ON A.CODE=B.CODE")
s.Append(" WHERE A.IDATE BETWEEN '").Append(date_from).Append("1'")
s.Append(" AND '").Append(date_to).Append("1'")
s.Append(" AND A.HOKAN ='KS10'")
'SW = False
's.Append(" AND A.HOKAN IN (")
'If CheckedListBox1.GetItemCheckState(0) = CheckState.Checked Then

' For IA = 1 To CheckedListBox1.Items.Count - 1
' If SW = False Then
' '初回
' s.Append("'").Append(CheckedListBox1.Items(IA).ToString).Append("'")
' SW = True
' Else
' '2回目以降
' s.Append(",'").Append(CheckedListBox1.Items(IA).ToString).Append("'")
' End If
' Next

'Else
' 'ALLがチェックされずに個別に指定していた場合
' For IA = 1 To CheckedListBox1.Items.Count - 1
' If CheckedListBox1.GetItemCheckState(IA) = CheckState.Checked Then
' If SW = False Then
' '初回
' s.Append("'").Append(CheckedListBox1.Items(IA).ToString).Append("'")
' SW = True
' Else
' '2回目以降
' s.Append(",'").Append(CheckedListBox1.Items(IA).ToString).Append("'")
' End If
' End If
' Next

'End If
's.Append(")")
s.Append(" GROUP BY A.CODE,A.HOKAN,A.IDATE,B.NAME ")
s.Append(" ORDER BY A.IDATE,A.CODE,A.HOKAN ")

Debug.WriteLine("----------")
Debug.WriteLine(s.ToString)
SQLSelect = New SqlClient.SqlCommand(s.ToString, CNtpics)

SQLSelect.CommandTimeout = TimeOutSec
Adapter = New SqlClient.SqlDataAdapter(SQLSelect)
Dim DS As New DataSet
Try
Adapter.Fill(DS, "DS")
Catch EX As Exception
ErrSW = True
ErrSTR = EX.Message
Exit Sub
End Try

gDT = New DataTable
gDT = DS.Tables("DS")

Dim str As New System.Text.StringBuilder

str.Append("CODE").Append(vbTab)
str.Append("CODE NAME").Append(vbTab)
str.Append("Warehouse ").Append(vbTab)
str.Append("NUMBER").Append(vbTab)
str.Append("DATE").Append(vbNewLine)

For IA = 0 To gDT.Rows.Count - 1
ProgressBar1.Value = IA
For ib = 0 To gDT.Columns.Count - 1
Select Case ib

Case 4
str.Append(Mid(gDT.Rows(IA).Item(ib), 1, 4)).Append("/")
str.Append(Mid(gDT.Rows(IA).Item(ib), 5, 2)).Append("/")
str.Append(Mid(gDT.Rows(IA).Item(ib), 7, 2)).Append(vbTab)
Case Else
str.Append(gDT.Rows(IA).Item(ib)).Append(vbTab)
End Select

Next
str.Append(vbNewLine)
Next

'============================
'EXCEL output
'============================
Dim xlsBook As Excel.Workbook
Dim xlsApp As Excel.Application
Dim xlsSheet As Excel.Worksheet

Try

xlsApp = CreateObject("Excel.Application")
xlsBook = xlsApp.Workbooks.Add
xlsBook.Worksheets.Add()
xlsSheet = xlsBook.Worksheets(1)
xlsApp.Application.Visible = True

With xlsSheet
Clipboard.Clear()
Clipboard.SetDataObject(str.ToString)
.Activate()
.Range("A1").Select()
.Paste()
.Range("A:A").NumberFormatLocal = "@"
.Range("A:A").HorizontalAlignment = Excel.XlHAlign.xlHAlignLeft
'.Range("A:A").NumberFormat = "#,##0_"
.Cells.Select()
.Cells.EntireColumn.AutoFit()
.Range("A1").Select()
End With

Catch ex As Exception
MsgBox(ex.ToString, MsgBoxStyle.Exclamation, Me.Text)
YUKO()
End Try

[水猿兵团五哥]

代码贴出来看看
你可以自己写代码导出到EXCEl中，不用他的导出功能，而且
自带导出功能导出的没有线框之类的格式