注:测试环境是BS结构,以下代理属性为"web代理" ,'在代理列表中选择','对象无'
|
Sub Initialize '此代理把output试图中的内容打印显示到excel文件里。 要注意多值情况要在视图里@implode 预先处理好 On Error Goto errp Dim session As New notessession Dim db As notesdatabase Set db=session.currentdatabase Dim view As notesview Set view=db.getview("output") '1 'iPageLine=Int(Inputbox("每页行数?")) 把大量数据分页输出 不分页的话,可以指定一个大点的整数例如 500 iPageLine=Int(500) Dim excelApplication As Variant Dim excelWorkbook As Variant Dim excelSheet As Variant Set excelApplication = CreateObject("Excel.Application") excelApplication.Visible = True Set excelWorkbook = excelApplication.Workbooks.Add Set excelSheet = excelWorkbook.Worksheets("Sheet1") REM 输出开始 '设置行高 excelSheet.Rows.RowHeight=40 '完成 '垂直居中 excelSheet.Rows.VerticalAlignment =2 '完成 Dim navigator As notesviewnavigator Dim entry As notesviewentry Set navigator=view.createviewnav() Set entry=navigator.getfirst i=0 Do While(Not entry Is Nothing) If i Mod iPageLine=0 Then '10行换页[A4] If i<>0 Then j=1 Forall columnvalue In Entry.columnvalues excelSheet.Cells(i,j)=columnvalue j=j+1 End Forall Set entry=navigator.getnext(entry) End If excelSheet.Range(Cstr(i+1)+":"+Cstr(i+1)).Font.Size=18 excelSheet.Range(Cstr(i+1)+":"+Cstr(i+1)).Borders.Weight=1 excelSheet.Rows(i+1).RowHeight=60 excelSheet.Range("A"+Cstr(i+1)+":"+"E"+Cstr(i+1)).Merge(True) '合并单元格 excelSheet.Range("A"+Cstr(i+1)+":"+"E"+Cstr(i+1)).MergeCells=True '合并单元格 excelSheet.Cells(i+1,1)="报表名称" excelSheet.Cells(i+1,1).HorizontalAlignment=3 excelSheet.Cells(i+1,1).VerticalAlignment=3 k=1 Forall m In view.columns excelSheet.Cells(i+2,k)=m.title excelSheet.Cells(i+2,k).HorizontalAlignment=3 k=k+1 End Forall i=i+3 Else j=1 Forall columnvalue In Entry.columnvalues excelSheet.Cells(i,j)=columnvalue '输出内容到Excel表格内容!!! '设置列宽 excelSheet.Columns(j).ColumnWidth=20 '完成 j=j+1 End Forall Set entry=navigator.getnext(entry) i=i+1 End If Loop i=i-1 If i Mod iPageLine<>0 Then For k=1 To iPageLine-(i Mod iPageLine) excelSheet.Cells(i+k,1)=" " Next End If REM 输出结束 excelSheet.UsedRange.Select 'excelSheet.UsedRange.EntireColumn.AutoFit excelSheet.UsedRange.WrapText=True excelSheet.UsedRange.Borders.Weight=2 excelSheet.UsedRange.VerticalAlignment = 3 'excelSheet.UsedRange.HorizontalAlignment=4'水平右对齐 excelWorkbook.PersonalViewPrintSettings=True '单元格中文本自动换行 excelWorkbook.PrintPreview REM excelWorkbook.PrintOut excelApplication.quit Set excelSheet=Nothing Exit Sub errp: Msgbox "(" & Cstr(Erl) & " ) -> " & Error$(Err) End Sub |
如果需要自动产生Excel硬盘文件,还需要一点改动:
|
Dim ExcelName As String ExcelName = Cstr(Year(Now))+Cstr(Month(Now))+Cstr(Day(Now))+Cstr(Hour(Now))+Cstr(Second(Now)) ExcelName = "D:\"+ExcelName +".xls" ................................ 中间代码 ................................. excelapplication.workbooks(1).saveas(ExcelName) excelapplication.workbooks.close |