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

最新推荐文章于 2020-10-12 10:28:59 发布

gjd111686

最新推荐文章于 2020-10-12 10:28:59 发布

阅读量1.7k

点赞数

分类专栏：经我试练的秘籍文章标签： excel session 报表

本文链接：https://blog.csdn.net/gjd111686/article/details/36251

版权

经我试练的秘籍专栏收录该内容

36 篇文章 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