我们来看看作为基类的Report的代码:
Public Const REPORT_TYPE_TABLE=0 'A table style report, write to a new sheet
Public Const REPORT_TYPE_TEMPLATE=1 'Write to a Excel template with formats
Public Class Report
Private reportType As Integer
Private template As String 'Template name in the case of REPORT_TYPE_TEMPLATE
Private VIEW_TEMPLATE As String 'Name of the view storing templates
'Notes variables
Private session As NotesSession
Private db As NotesDatabase
Private ws As NotesUIWorkspace
Private viewExport As NotesView
'Excel relevant variables
Public Save As Boolean
Private xlFileName As String
Private xlApp As Variant
Private xlWork As Variant
Private xlSheet As Variant
Private writer As SheetWriter
Sub New()
me.reportType=REPORT_TYPE_TABLE
me.VIEW_TEMPLATE="vwExcelTemplate"
me.xlFileName = ""
Set session = New NotesSession
Set db = session.CurrentDatabase
Set ws=New NotesUIWorkspace
End Sub
'创建 Excel.Application 对象
Private Function CreateExcelObject() As Integer
CreateExcelObject = False
If me.reportType=REPORT_TYPE_TABLE And me.Save Then
If xlFileName = "" Then
Dim result As Variant
result=ws.Savefiledialog(False, "Lotus Notes", "Excel workbook|*.xlsx|Excel 97-2003 workbook|*.xls")
If IsEmpty(result) Then Exit Function
me.xlFileName=result(0)
End If
End If
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
'Error 6503,"创建 Excel.Application 对象失败,请确认是否安装Excel 。"
Error 6503, "Failed to create an Excel object. Check if Excel is installed."
End If
xlApp.Visible = False
If me.reportType=REPORT_TYPE_TABLE then
Set xlWork = xlApp.Workbooks.Add
Else
Set xlWork=xlApp.Workbooks.Open(me.xlFileName)
End If
xlApp.referenceStyle = 2
Set xlSheet = xlApp.Workbooks(1).Worksheets(1)
Set writer=New SheetWriter(me.xlSheet)
If me.Save Then
Call xlWork.SaveAs( xlFilename )
End If
CreateExcelObject = True
Exit Function
End Function
%REM
Function ExtractTemplate
Description: Comments for Function
%END REM
Private Function ExtractTemplate() As Boolean
ExtractTemplate=False
Dim doc As NotesDocument
Set doc=GetDocByKey(me.VIEW_TEMPLATE, me.template)
If doc Is Nothing Then
Exit Function
End If
'The template is stored in the 'Template' item
Dim rtItem As NotesRichTextItem
Set rtItem=doc.GetFirstItem("Template")
Dim eo As NotesEmbeddedObject
Set eo=rtItem.Embeddedobjects(0)
If eo Is Nothing Then
Exit Function
End If
Dim temp As String
temp=Environ("TEMP")
Dim path As String
randomize
path=temp & "\" & Rnd() & eo.Name
Call eo.Extractfile(path)
me.xlFileName=path
ExtractTemplate=True
End Function
Public Function Export() As Integer
Export = False
If me.reportType=REPORT_TYPE_TEMPLATE Then
If Not me.ExtractTemplate() Then
Exit Function
End If
End If
If Not CreateExcelObject() Then Exit Function
If me.reportType=REPORT_TYPE_TABLE Then
Call ExportTitle() '把视图标题行导出到Excel文件的第一行
End If
Call ExportData() '开始导出数据
If me.Save Then
Call xlWork.Save()
Call xlApp.Quit()
MsgBox "A report is successfully saved to " & xlFileName & "."
Else
me.xlApp.Visible=True
End If
Export = True
End Function
%REM
If the report type is TABLE, write the first line of the worksheet as column headers.
To be overloaded in sub classes.
%END REM
Private Function ExportTitle
End Function
'Write in the worksheet, to be overloaded in sub classes.
Private Function ExportData()
End Function
End Class
这个类做的包括创建和销毁Excel对象,读取配置好的Excel模板,实现公共的Export()方法和定义两个私有的空方法接口。
下面是一个实现表格型报表的实例:
Public Class LiaisonReport As ExpReport
'internal variables
Private intYear As Integer
Private intMonth As Integer
Private otherCols As NArray
Private nav As NotesViewNavigator
Sub New(selYear As Integer, selMonth As Integer)
me.intYear=selYear
me.intMonth=selMonth
Set viewExport=db.Getview("vhLiaisonForm")
Set otherCols=New NArray(-1)
With otherCols
Call .Add("Month")
Call .Add("Day")
Call .Add("Year")
Call .Add("Description")
Call .Add("Nature")
Call .Add("Nature Desc.")
Call .Add("Amount")
Call .Add("Source")
Call .Add("Type")
Call .Add("Chart of account")
Call .Add("Expense account")
Call .Add("No")
Call .Add("Pay from")
Call .Add("Office")
Call .Add("Unit")
Call .Add("Check No.")
End With
Dim v As Variant
v=accountInfos.GetList()
End Sub
Private Function ExportData
Dim entryCol As NotesViewEntryCollection
Dim entry As NotesViewEntry
Dim detailDc As NotesDocumentCollection
Dim detailDoc As NotesDocument
Dim keys(1) As Integer
keys(0)=me.intYear
keys(1)=me.intMonth
Set nav=me.viewExport.Createviewnavfromcategory(CStr(intYear)&"-"&Cstr(intMonth))
Set entry=nav.Getfirst()
Do Until entry Is Nothing
Call me.WriteCols(entry)
Call writer.NextRow()
Set entry=nav.Getnextcategory(entry)
Loop
End Function
Private Function ExportTitle()
Dim cols As Variant
Dim i As Integer
cols=me.otherCols.container
For i=0 To UBound(cols)
writer.WriteCell(cols(i))
Next
Call writer.NextRow()
End Function
%REM
Description: Comments for Function
%END REM
Private Function WriteCols(entry As NotesViewEntry)
Dim amount As Double
amount=entry.Columnvalues(4)
Set entry=nav.Getchild(entry)
Dim doc As NotesDocument
Set doc=entry.Document
Dim ed As New ExtDoc(doc)
'Calculate the "expense office" used to get office code
Dim office As String
office=doc.Getitemvalue("Office")(0)
Dim payFrom As String
payFrom=doc.Getitemvalue("expPayfrom")(0)
Dim ctg As String
ctg=GetValueByKey("vwPaymentSource", payFrom, "Category", "")
Dim expOffice As String
If ctg="Bank" Then
expOffice=GetValueByKey("vwPaymentSource", payFrom, "Office", "")
Else
expOffice=office
End If
Dim code As String
code=GetValueByKey("vwOffice", expOffice, 1, "")
'Month
writer.WriteCell(Month(doc.Getitemvalue("PLYM")(0)))
'Day
writer.WriteCell(Day(doc.Getitemvalue("PLYM")(0)))
'Year
writer.WriteCell(Year(doc.Getitemvalue("PLYM")(0)))
'Description
writer.WriteCell(doc.Getitemvalue("Title")(0))
'Nature
Dim account As String
Dim nature As String
Dim ai As AccountInfo
account=doc.Getitemvalue("expChart")(0)
If me.accountInfos.Contains(account) Then
Set ai=me.accountInfos.Item(account)
nature=ai.Nature
Else
nature=""
End If
writer.WriteCell(nature)
'Nature Desc
Dim desc
desc=GetValueByKey("vwNature", nature, 1, "")
If IsEmpty(desc) Then
desc=""
End If
writer.WriteCell(desc)
'Amount
writer.WriteCell(amount)
'Source
Dim chart As String
Dim source As String
chart=LCase(doc.Getitemvalue("expChart")(0))
If chart="citi" Or chart="others" Or chart="pc" Then
source="C"
End If
If ctg="Bank" Then
source="C"
Else
source="P"
End If
writer.WriteCell(source)
'Type
Dim sType As String
Select Case chart
Case "citi"
sType="W"
Case "others"
sType="I"
Case "pc"
sType="T"
Case Else
sType="E"
End Select
writer.WriteCell(sType)
'Chart of account
writer.WriteCell(doc.Getitemvalue("expChart")(0) & "-" & code)
'Expense account
writer.WriteCell(doc.Getitemvalue("expAccount")(0))
'No
writer.WriteCell(doc.Getitemvalue("No")(0))
'Pay from
writer.WriteCell(doc.Getitemvalue("expPayfrom")(0))
'Office
writer.WriteCell(office)
'Unit
Dim unit As Variant
unit=DBLookup("vwOffice", office, 3, "")
If IsEmpty(unit) Then
unit=""
Else
unit=unit(0)
End If
writer.WriteCell(unit)
'Check No.
writer.WriteCell(ed.GetParentDoc().Getitemvalue("expCheck")(0))
End Function
End Class
构造函数New()接受两个用户在界面上选择的分别代表年份和月份的数字,决定后面要导出的数据的范围;设置要从其中导出报表的视图viewExport;初始化报表的列标题。方法ExportData()描述如何找到要导出的数据集合,调用WriteCols方法写入工作表。方法ExportTitle()简单将预设的列标题写入。方法WriteCols()具体计算报表的每一列。
调用的界面和结果如下: