38. 面向对象的LotusScript（十）之导出Excel（二）

柔情只为你懂 2022-01-12 14:49 272阅读 0赞

我们来看看作为基类的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()具体计算报表的每一列。

调用的界面和结果如下：

![SouthEast][]  
![SouthEast 1][]

[SouthEast]: /images/20220112/5bdc8684689c4b43b9de247160c2d94c.png
[SouthEast 1]: /images/20220112/9407e56fc25d4676bcda937fc1c4c8fe.png