通用视图导入Excel打印代码，大家拷贝[免费]

gjd111686 2002-01-16 02:22:43

Sub Initialize
Dim session As New notessession
Dim db As notesdatabase
Set db=session.currentdatabase

Dim view As notesview
REM Set view=db.getview("DefaultView")
Dim category As String
category=Inputbox("请输入要统计汇总打印的文件字号","选择文号分类","中油辽字")
REM Messagebox(category)

Dim collection As notesdocumentcollection
Dim m_datetime As New notesdatetime("")
Call m_datetime.setnow()
Call m_datetime.adjustyear(-5) '当前时间减去5年
Dim delcollection As notesdocumentcollection
Set delcollection=db.Search("Form=""InceptDoc""",m_datetime,0)
Call delcollection.removeallfromfolder("StatPrintView")
REM Messagebox("@contains(DocumentCode;"+category+")")
If category="" Then
Set collection = db.Search("Form=""InceptDoc""",m_datetime,0)
Else
Set collection = db.Search("@contains(DocumentCode;"""+category+""")",m_datetime,0)
End If
REM Messagebox("符合条件记录数:"+Cstr(collection.count))
Call collection.putallinfolder("StatPrintView")
Set view=db.getview("StatPrintView")

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 输出开始
Dim i,j,h,l As Integer
i=1
j=1
h=1
l=1

'设置行高
excelSheet.Rows.RowHeight=40
'完成
'垂直居中
REM excelSheet.Rows(1).VerticalAlignment = xlVAlignCenter
excelSheet.Rows.VerticalAlignment =2
'完成

Dim navigator As notesviewnavigator
Dim entry As notesviewentry
Set navigator=view.createviewnav()
Set entry=navigator.getfirst
i=0
Dim strcal As String
Do While(Not entry Is Nothing)
If i Mod 10=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
strcal=Cstr(i+1)+":"+Cstr(i+1)
excelSheet.Range(strcal).Font.Size=18
excelSheet.Range(strcal).Borders.Weight=1
excelSheet.Rows(i+1).RowHeight=60
strcal="A"+Cstr(i+1)+":"+"E"+Cstr(i+1)
excelSheet.Range(strcal).MergeCells=True '合并单元格
excelSheet.Cells(i+1,1)="收文处理登记表"
excelSheet.Cells(i+1,1).HorizontalAlignment=3

'excelSheet.Range(strcal).Value="收文处理登记表"
h=1
Forall m In view.columns
excelSheet.Cells(i+2,h)=m.title
excelSheet.Cells(i+2,h).HorizontalAlignment=3
h=h+1
End Forall
i=i+3
Else
j=1
Forall columnvalue In Entry.columnvalues
excelSheet.Cells(i,j)=columnvalue
j=j+1
End Forall
l=j-1
Set entry=navigator.getnext(entry)
i=i+1
End If
Loop
i=i-1
Dim k As Integer
k=1
If i Mod 10<>0 Then
For k=1 To 10-(i Mod 10)
excelSheet.Cells(i+k,l)=" "
Next
End If
REM 输出结束

excelSheet.UsedRange.Select
'excelSheet.UsedRange.EntireColumn.AutoFit
excelSheet.UsedRange.WrapText=True
'设置列宽
For t=1 To l
excelSheet.Columns(t).ColumnWidth=20
Next
excelSheet.Columns(l).ColumnWidth=30
'完成

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

...全文