____________vb生成excel报表速度太慢了,请高手给改进或改正方法
Do Until rs_xls.EOF
srcTableName = rs_xls( "TABLENAME ")
strSQL1 = "select * from " & srcTableName '从数据表中取数据
rs_src.Open strSQL1, Mconn
Icol = rs_src.Fields.count '取得excel表列数
On Error GoTo ExitApp
mStartRow = rs_xls( "STARTROW ")
mExcelPath = rs_xls( "LOADPATH ")
If Dir(mExcelPath) <> " " Then
Set xlApp = CreateObject( "Excel.Application ")
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Open(mExcelPath) '打开EXCEL工作簿
Set xlSheet = xlBook.Worksheets(1) '打开EXCEL工作表
'写表头
For i = 1 To 30
ni = Format(CStr(i), "00 ")
CellValue = "Line " & ni
With xlSheet
For j = 1 To mStartRow - 1
For k = 1 To Icol
If InStr(.Cells(j, k).Value, CellValue) Then
.Cells(j, k).Value = Replace(.Cells(j, k).Value, "Line " & ni, Trim(rs_xls( "Line " & ni)))
End If
Next
Next
End With
Next
If Not rs_src.EOF Then
'写EXCEL表中数据区的内容
i = mStartRow
srcRecordCount = 0
rs_src.MoveFirst
Do Until rs_src.EOF
For j = 0 To Icol - 1
xlSheet.Cells(i, j + 1).Value = Trim(rs_src(j))
With xlSheet.Cells(i, j + 1)
.HorizontalAlignment = mSubTitleFmt.HorizontalAlignment
.VerticalAlignment = mSubTitleFmt.VerticalAlignment
End With
Next
i = i + 1
srcRecordCount = srcRecordCount + 1
rs_src.MoveNext
Loop
'指定产品名称列的格式
With xlSheet.Range(xlSheet.Cells(mStartRow, 1), xlSheet.Cells(mStartRow + srcRecordCount - 1, 1))
.Font.Name = mSubTitleFmt.fontname
.Font.Size = mSubTitleFmt.fontsize
.Font.Bold = mSubTitleFmt.fontbold
.Font.Italic = mSubTitleFmt.fontitalic
.HorizontalAlignment = mSubTitleFmt.HorizontalAlignment
.VerticalAlignment = mSubTitleFmt.VerticalAlignment
End With
End If
'设表格边框样式
xlSheet.Range(xlSheet.Cells(mStartRow, 1), xlSheet.Cells(mStartRow + srcRecordCount - 1, Icol)).Borders.LineStyle = xlContinuous
Else
MsgBox "指定的EXCEL模板 " & vbCrLf & mExcelPath & " 不存在 ", vbExclamation + vbOKOnly
rs_xls.Close
rs_src.Close
Exit Sub
End If
代码如上,报表有固定格式,因此使用了相应的模版,生成报表时将从库中读取的数据一一写入模版,但是速度太慢了,类似的报表要生成上万张,有没有好一点的改进方法呀?
谢谢啦,很着急。
[解决办法]
用记录集copy的方法,很快
[解决办法]
看看WPS会不会快些?
去他的网站找他的二次开发支持吧