xpage中报表生成

代理中代码

Sub Initialize
	On Error GoTo errHandler
	
	Dim session As New NotesSession
	Dim db As New NotesDatabase("","")
	Dim view As NotesView
	Dim entry As NotesViewEntry
	Dim vc As NotesViewEntryCollection
	
	Set db = session.Currentdatabase
	Set view = db.GetView("通讯录")
	Set vc = view.AllEntries
	
	Dim ddir As String
	ddir = session.GetEnvironmentString("Directory",True) & "\domino\html\"
	Dim fn As String
	fn = ddir+"公司通讯录.xls"
	Print(fn)
	
	
	Dim xlApp As Variant
	Dim xlWorkBook As Variant
	Dim xlSheet As Variant
	
	Dim myVersion As String
	Dim row As Integer
	Set xlApp = createObject("excel.application")
	xlApp.visible = False
	
	
	Select Case Val(xlApp.application.Version)
		Case 5
			myVersion = "5.0"
		Case 7
			myVersion = "95"
		Case 8
			myVersion = "97"
		Case 9
			myVersion = "2000"
		Case 10
			myVersion = "2002"
		Case 11
			myVersion = "2003"
		Case 12
			myVersion = "2007"
		Case 14
			myVersion = "2010"
		Case Else
			myVersion = "版本不明"
	End Select
	
	
	Dim numL As String
	
	Set xlWorkBook = xlApp.WorkBooks.Add
	
	Dim pdoc As NotesDocument
	
	Set xlSheet = xlWorkBook.Sheets(1)
	'xlSheet.name = Month(doc.datTJ(0))
	With xlSheet

		.Rows(1).font.size=20
		.Rows(2).font.size=12
		.Rows(3).font.size=12
		.Rows(1).font.Bold=True
		.Rows(2).font.Bold=True
		.Rows(3).font.Bold=True
		.Rows(4).font.Bold=True
		
		.Rows(1).HorizontalAlignment=3
		.Rows(1).RowHeight=27
		.Rows(2).HorizontalAlignment=3
		.Rows(2).RowHeight=18.75
		.Rows(3).HorizontalAlignment=3
		.Rows(3).RowHeight=12.75
		
		.Cells(4,1).HorizontalAlignment=3
		.Cells(4,2).HorizontalAlignment=3	
		.Cells(4,3).HorizontalAlignment=3
		.Cells(4,4).HorizontalAlignment=3
		.Cells(4,5).HorizontalAlignment=3
		.Cells(4,6).HorizontalAlignment=3
		.Cells(4,7).HorizontalAlignment=3
		
		.Cells(4,1).font.Bold=True
		.Cells(4,2).font.Bold=True
		.Cells(4,3).font.Bold=True
		.Cells(4,4).font.Bold=True
		.Cells(4,5).font.Bold=True
		.Cells(4,6).font.Bold=True
		.Cells(4,7).font.Bold=True
		
		row = 5
		
		Dim txtDep As String
		Set entry = vc.GetFirstEntry
		
		While Not(entry Is Nothing)
			If(entry.ColumnValues(0) = "") Then
				.Cells(row,1) = entry.ColumnValues(1)
				.cells(row,2) = entry.ColumnValues(2)
				.cells(row,3) = entry.ColumnValues(3)
				.cells(row,4) = entry.ColumnValues(4)
				.cells(row,5) = entry.ColumnValues(5)
				.Cells(row,6) = entry.ColumnValues(6)
				.cells(row,7) = entry.ColumnValues(7)
			Else
				If(txtDep = "" Or txtDep<>entry.ColumnValues(0)) Then
					.Cells(row,1) = entry.ColumnValues(0)
					txtDep = entry.ColumnValues(0) 
					
					.Range(.Cells(row,1),.Cells(row,7)).merge(False)
					.cells(row,1).HorizontalAlignment=-4131
					.Cells(row,1).font.Bold=True
				Else
					row = row - 1
				End If
				
				
				
				row = row + 1
				.Cells(row,1) = entry.ColumnValues(1)
				.cells(row,2) = entry.ColumnValues(2)
				.cells(row,3) = entry.ColumnValues(3)
				.cells(row,4) = entry.ColumnValues(4)
				.cells(row,5) = entry.ColumnValues(5)
				.Cells(row,6) = entry.ColumnValues(6)
				.cells(row,7) = entry.ColumnValues(7)
			End If
			
			
			.Rows(row).font.size=12
			.Rows(row).HorizontalAlignment=3
			
			'.cells(row,2).HorizontalAlignment=-4131
			
			row = row + 1
			Set Entry = vc.GetNextEntry(Entry)
		Wend
		
		.Columns(7).ColumnWidth = 21.38
		.Columns(6).ColumnWidth = 9.13
		.Columns(5).ColumnWidth = 15.5
		.Columns(4).ColumnWidth = 12.13
		.Columns(3).ColumnWidth = 12.13
		.Columns(2).ColumnWidth = 12.13
		.Columns(1).ColumnWidth = 13.25
		.Range(.Cells(4,1),.Cells(row - 1,7)).Borders.LineStyle = 1
		.Range(.Cells(1,7),.Cells(row - 1,7)).Borders(10).Weight = -4138     '10左
		.Range(.Cells(4,1),.Cells(4,7)).Borders(8).Weight = -4138
		.Range(.Cells(row-1,1),.Cells(row-1,7)).Borders(9).Weight = -4138	'9下
		
	End With
	
	If myVersion="2007" Or myVersion="2010" Then
		Call xlWorkbook.saveas(fn,56,"","",False,False)
	Else
		Call xlWorkbook.saveas(fn)
	End If
getOut:
	Exit Sub
errHandler:
	MsgBox Error$ & " (" & Err & " at line " & Erl & ")",,"Error"  
	Resume getOut
End Sub

按钮代码

var db:NotesDatabase = session.getCurrentDatabase();
var agent = db.getAgent("excel");
agent.runOnServer();

链接代码

<xp:scriptBlock id="scriptBlock1">
		<a href="/公司通讯录.xls">下载</a>
	</xp:scriptBlock>