呵呵,再给您看看 Option ExplicitPrivate Type ExlCell Row As Long Col As Long End TypeDim ExcelSheet As Excel.Application Dim ValuesArray() As StringPublic Function MakeExcelFile(MasterRs As ADODB.Recordset, FieldsArray() As String, _ ReportCaption As String, MasterForm As frmCreateReport)
Dim WS As Worksheet Dim StCell As ExlCell
Screen.MousePointer = vbHourglass Set ExcelSheet = CreateObject("Excel.Application") ExcelSheet.Workbooks.Add ExcelSheet.Worksheets(1).Name = ReportCaption Set WS = ExcelSheet.Worksheets(1)
ExcelSheet.Visible = True ExcelSheet.Interactive = True Set ExcelSheet = Nothing End Function Private Sub CopyRecords(RST As ADODB.Recordset, WS As Worksheet, StartingCell As ExlCell, _ FieldsArray() As String, MasterForm As frmCreateReport)
Dim SomeArray() As Variant Dim Row As Long Dim Col As Long Dim Recs As Integer Dim Counter As Integer Dim i As Integer
If RST.EOF And RST.BOF Then Exit Sub RST.MoveLast ReDim SomeArray(RST.RecordCount + 1, UBound(FieldsArray)) Col = 0 For Col = 0 To UBound(FieldsArray) SomeArray(0, Col) = FieldsArray(Col) Next RST.MoveFirst Recs = RST.RecordCount Counter = 0 For Row = 1 To RST.RecordCount Counter = Counter + 1 If Counter <= Recs Then i = (Counter / Recs) * 100 MasterForm.UpdateProgress i For Col = 0 To UBound(FieldsArray) SomeArray(Row, Col) = RST.Fields(FieldsArray(Col)).Value If IsNull(SomeArray(Row, Col)) Then _ SomeArray(Row, Col) = "" Next RST.MoveNext Next WS.Range(WS.Cells(StartingCell.Row, StartingCell.Col), _ WS.Cells(StartingCell.Row + RST.RecordCount, _ StartingCell.Col + UBound(FieldsArray))).Value = SomeArray
For Row = 1 To RST.RecordCount Counter = Counter + 1 If Counter <= Recs Then i = (Counter / Recs) * 100 MasterForm.UpdateProgress i For Col = 0 To UBound(FieldsArray) SomeArray(Row, Col) = RST.Fields(FieldsArray(Col)).Value If IsNull(SomeArray(Row, Col)) Then _ SomeArray(Row, Col) = "" Next RST.MoveNext Next 这里生成报表数据,按照提供的字段
Set xlApp = New Excel.Application ---- 然后,可以用这些变量来访问在EXCEL应用程序中的从属对象、以及这些对象的属性和方法。例如: Set xlApp = CreateObject("Excel.Application")
‘激活EXCEL应用程序
xlApp.Visible = False ‘隐藏EXCEL应用程序窗口
Set xlBook = xlApp.Workbooks.Open(strDestination)
‘打开工作簿,strDestination为一个EXCEL报表文件
Set xlSheet = xlBook.Worksheets(1)
‘设定工作表 ---- 二. 用EXCEL 97设计报表的模版文件 ---- EXCEL 97是一个非常优秀的创建报表的工具。它提供的单元格任意合并、拆分和绘图功能基本上能够满足设计所有复杂报表的需求。它对任意一个单元格的格式随意控制,更为随心所欲地设计报表提供了强大的支持。 ---- 根据用户提供的报表,我们可以很快在EXCEL里生成模版文件。所谓生成模版文件只是为了满足用户多方面的需求而设计的。也是为了适合报表以后的更改而做的一点预备工作。例如用户需要打印几百张职工履历表,但其格式都是一致的,并且随着时间和实际情况的变化,表格格式有可能需要改变,我们设计一个模版文件显然可以“以不变应万变”了。 ---- 生成工作表时我们应当记录下要填充内容的单元格编号和该单元格内要填充的数据字段。这样形成一个表格,在写程序时一目了然。如: Cell(4,2) 职工姓名 Cell(6,6) 毕业学校
Cell(4,4) 职工性别 Cell(6,7) 所学专业
Cell(4,6) 职工民族 Cell(6,9) 工作时间
(表一) ---- 在程序里我们当然不要对模版文件进行操作了,我们只需要对模版文件的一个拷贝进行操作就行(这也是我们设计模版文件的一个目的和好处)。如下面的例子: Dim strSource, strDestination As String
strSource = App.Path & "\Excels\RegisterFee.xls"
‘RegisterFee.xls就是一个模版文件
strDestination = App.Path & "\Excels\Temp.xls"
FileCopy strSource, strDestination
‘将模版文件拷贝到一个临时文件 ---- 三. 生成工作表内容 ---- 有了上述两步工作的铺垫,我们下面接着就只要根据(表一)的格式给各单元格赋值了。如: datPrimaryRS.Recordset.MoveFirst
‘datPrimaryRS为Data控件
If IsNull(datPrimaryRS.Recordset!姓名) = False Then
xlSheet.Cells(4, 2) = datPrimaryRS.Recordset!姓名
End If
If IsNull(datPrimaryRS.Recordset!性别) = False Then
xlSheet.Cells(4, 4) = datPrimaryRS.Recordset!性别
End If
If IsNull(datPrimaryRS.Recordset!民族) = False Then
xlSheet.Cells(4, 6) = datPrimaryRS.Recordset!民族
End If
……………… ---- 四. 打印报表 ---- 生成了工作表后,就可以对EXCEL发出打印指令了。 ---- 注意在执行打印操作之前应该对EXCEL临时文件执行一次保存操作,以免在退出应用程序后EXCEL还提示用户是否保存已修改的文件,让用户觉得莫名其妙。如下语句: xlBook.Save ‘保存文件
xlSheet.PrintOut ‘执行打印
xlApp.Quit ‘退出EXCEL ---- 至此应该看到,我们设计的报表打印是通过EXCEL程序来后台实现的。用户根本看不到具体过程,他们只看到一张张漂亮的报表轻易地被打印出来了。
Option ExplicitPrivate Type ExlCell
Row As Long
Col As Long
End TypeDim ExcelSheet As Excel.Application
Dim ValuesArray() As StringPublic Function MakeExcelFile(MasterRs As ADODB.Recordset, FieldsArray() As String, _
ReportCaption As String, MasterForm As frmCreateReport)
Dim WS As Worksheet
Dim StCell As ExlCell
Screen.MousePointer = vbHourglass Set ExcelSheet = CreateObject("Excel.Application")
ExcelSheet.Workbooks.Add
ExcelSheet.Worksheets(1).Name = ReportCaption
Set WS = ExcelSheet.Worksheets(1)
StCell.Col = 1
StCell.Row = 3
Call CopyRecords(MasterRs, WS, StCell, FieldsArray, MasterForm)
Screen.MousePointer = vbDefault
ExcelSheet.Visible = True
ExcelSheet.Interactive = True
Set ExcelSheet = Nothing
End Function
Private Sub CopyRecords(RST As ADODB.Recordset, WS As Worksheet, StartingCell As ExlCell, _
FieldsArray() As String, MasterForm As frmCreateReport)
Dim SomeArray() As Variant
Dim Row As Long
Dim Col As Long
Dim Recs As Integer
Dim Counter As Integer
Dim i As Integer
If RST.EOF And RST.BOF Then Exit Sub
RST.MoveLast
ReDim SomeArray(RST.RecordCount + 1, UBound(FieldsArray))
Col = 0
For Col = 0 To UBound(FieldsArray)
SomeArray(0, Col) = FieldsArray(Col)
Next
RST.MoveFirst
Recs = RST.RecordCount
Counter = 0
For Row = 1 To RST.RecordCount
Counter = Counter + 1
If Counter <= Recs Then i = (Counter / Recs) * 100
MasterForm.UpdateProgress i
For Col = 0 To UBound(FieldsArray)
SomeArray(Row, Col) = RST.Fields(FieldsArray(Col)).Value
If IsNull(SomeArray(Row, Col)) Then _
SomeArray(Row, Col) = ""
Next
RST.MoveNext
Next WS.Range(WS.Cells(StartingCell.Row, StartingCell.Col), _
WS.Cells(StartingCell.Row + RST.RecordCount, _
StartingCell.Col + UBound(FieldsArray))).Value = SomeArray
WS.Range(WS.Cells(StartingCell.Row, StartingCell.Col), _
WS.Cells(StartingCell.Row + RST.RecordCount, _
StartingCell.Col + UBound(FieldsArray))).HorizontalAlignment = xlRight
WS.Range(WS.Cells(StartingCell.Row, StartingCell.Col), _
WS.Cells(StartingCell.Row + RST.RecordCount, _
StartingCell.Col + UBound(FieldsArray))).Borders.LineStyle = xlContinuous
WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).Merge
WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).Font.Size = 20
WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).Font.Bold = True
WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).Value = WS.Name
WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).HorizontalAlignment = xlCenter
WS.Columns.AutoFit
MasterForm.UpdateProgress 100
End Sub其中RecordSet中按照您指定的了
Counter = Counter + 1
If Counter <= Recs Then i = (Counter / Recs) * 100
MasterForm.UpdateProgress i
For Col = 0 To UBound(FieldsArray)
SomeArray(Row, Col) = RST.Fields(FieldsArray(Col)).Value
If IsNull(SomeArray(Row, Col)) Then _
SomeArray(Row, Col) = ""
Next
RST.MoveNext
Next
这里生成报表数据,按照提供的字段