ITPub博客

首页 > Linux操作系统 > Linux操作系统 > Domino中通用的视图打印(利用Excel打印)

Domino中通用的视图打印(利用Excel打印)

原创 Linux操作系统 作者:genusBIT 时间:2010-01-28 10:32:04 0 删除 编辑

Sub Initialize
 Dim session As New notessession
 Dim db As notesdatabase
 Set db=session.currentdatabase
 
 Dim view As notesview
 Set view=db.getview("PrintView")
 
 iPageLine=Int(Inputbox("每页行数?"))
 
 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
    '设置列宽
    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
End Sub

来自 “ ITPUB博客 ” ,链接:https://blog.itpub.net/14751907/viewspace-626220/ ,如需转载,请注明出处,否则将追究法律责任。

请登录后发表评论 登录
全部评论

注册时间:2008-07-04

  • 博文量
    233
  • 访问量
    483833