在domino开发中我们不可避免的要和报表打交道，一般就是生成各种Excel报表，本人主要为了自己在开发中方便，简单实现了一个基本类，现在功能有限，当然这个类我慢慢的根据以后遇到的需求逐渐完善。
Const EXCEL_APPLICATION = "Excel.application"
Private Const BASEERROR = 1200
'Private Const ERROR_NOSUCHCELL = BASEERROR + 0
'Private Const ERRORTEXT_NOSUCHCELL = "Excel Report - Could not get data from cell."
Const REG_97 = "Software\\Microsoft\\Office\\8.0\\Common\\InstallRoot" 'Registry Key Office 97
Const REG_2000 = "Software\\Microsoft\\Office\\9.0\\Common\\InstallRoot" 'Registry Key Office 2000
Const REG_XP = "Software\\Microsoft\\Office\\10.0\\Common\\InstallRoot" 'Registry Key Office XP
Const REG_2003 ="Software\\Microsoft\\Office\\11.0\\Common\\InstallRoot" 'Registry Key Office 2003
Const NAME_97 = "Office 97"
Const NAME_2000 = "Office 2000"
Const NAME_XP = "Office XP"
Const NAME_2003 = "Office 2003"
Class ExcelHelper
Private xlApp As Variant ' Application object
Private strFilePath As String
Sub new(xlFilename As String, isVisible As Boolean)
On Error Goto GeneralError
Set xlApp = CreateObject(EXCEL_APPLICATION) ' open the application
xlApp.Workbooks.Add xlFilename ' create an Excel workbook
xlApp.Visible = isVisible ' make it visible (or not)
strFilePath = xlFilename ' store the filename
Goto ExitSub
GeneralError:
If Not (xlApp Is Nothing) Then xlApp.quit ' quit, if there is an error
Resume ExitSub
ExitSub:
End Sub
Public Function save
xlApp.ActiveWorkbook.SaveAs( strFilePath )
End Function
Public Function saveAs(newFilename)
xlApp.ActiveWorkbook.SaveAs( newFileName )
Public Function setCell( Sheet As Variant , row As Integer , column As Variant , value As Variant )
xlApp.Workbooks(1).Worksheets( Sheet ).Cells( row , column ).Value = value
End Function
Public Function getCell( Sheet As Variant , row As Integer , column As Variant ) As String
On Error Goto GeneralError
getCell = xlApp.Workbooks(1).Worksheets( Sheet ).Cells( row , column ).Value
Goto ExitSub
getCell = ""
ExitSub:
Public Function quit
If Not (xlApp Is Nothing) Then
xlApp.Quit
Set xlApp = Nothing
End If
Public Function setVisibility(isVisible As Boolean)
If (isVisible And Not xlApp.Visible) Then xlApp.Visible = True
If (Not isVisible And xlApp.Visible) Then xlApp.Visible = False
Public Function setSheetName(Sheet As Variant,sheetName As String)
xlApp.Workbooks(1).Worksheets( Sheet ).Select
xlApp.Workbooks(1).Worksheets( Sheet ).Name=sheetName
Public Function setCellColor(Sheet As Variant, row As Integer, column As Variant, innercolor As Variant)
If Cstr(innercolor) <> "" Then
xlApp.Workbooks(1).Worksheets( Sheet ).Cells( row , column ).Interior.ColorIndex = innercolor
End If
Public Function setCellFont(Sheet As Variant, row As Integer, column As Variant, style As Variant, size As Variant, color As Variant)
If Cstr(style) <> "" Then
xlApp.Workbooks(1).Worksheets( Sheet ).Cells( row , column ).Font.FontStyle = style
If Cstr(size) <> "" Then
xlApp.Workbooks(1).Worksheets( Sheet ).Cells( row , column ).Font.Size = size
If Cstr(color) <> "" Then
xlApp.Workbooks(1).Worksheets( Sheet ).Cells( row , column ).Font.ColorIndex = color
Public Function setRowFont(Sheet As Variant, row As Integer, style As Variant, size As Variant, color As Variant)
Dim rowpara As String
rowpara=Cstr(row)+":"+Cstr(row)
xlApp.Workbooks(1).Worksheets( Sheet ).Rows(rowpara).Select
xlApp.Selection.Font.FontStyle = style
xlApp.Selection.Font.Size = size
xlApp.Selection.Font.ColorIndex = color
Public Function getVersion() As String
Dim formula As String
Dim SWVersion As String
Dim Versions List As String
Dim v As Variant
Versions(NAME_97) = REG_97
Versions(NAME_2000) = REG_2000
Versions(NAME_XP) = REG_XP
Versions(NAME_2003) = REG_2003
Forall vers In Versions
formula$ = | (@RegQueryValue("HKEY_LOCAL_MACHINE"; "| & vers & |";"Path")) |
v = Evaluate( formula$ )
If v(0) <> "" Then
getVersion = Listtag(vers)
Goto ExitSub
End If
End Forall
getVersion = ""
GeneralError:
getVersion = ""
Public Function exportNotesView(view As NotesView, Sheet As Variant, OffsetRow As Integer, OffsetCol As Integer, isWithheader As Boolean, includeIcons As Boolean, includeColors As Boolean, includeHidden As Boolean)
Dim viewnav As NotesViewNavigator
Dim entry As NotesViewEntry
Dim viewcolumns As Variant
Dim column As Integer
Dim row As Integer
Dim i As Integer
Dim array(0 To 9) As String
array(0)="A"
array(1)="B"
array(2)="C"
array(3)="D"
array(4)="E"
array(5)="F"
array(6)="G"
array(7)="H"
array(8)="I"
array(9)="J"
Set viewnav = view.CreateViewNav()
Set entry = viewnav.GetFirstDocument()
viewcolumns = view.Columns
row = OffsetRow + 1
column = OffsetCol + 1
If isWithHeader Then
Forall vc In viewcolumns
Call Me.setCell(Sheet, row, column, vc.title)
column = column + 1
End Forall
End If
While Not (entry Is Nothing)
row = row + 1
column = OffsetCol + 1
Forall cv In entry.ColumnValues
If doColumnExport(viewcolumns(column - OffsetCol - 1), includeHidden, IncludeIcons, includeColors) Then
Call Me.setCell(Sheet, row, column, Cstr(cv))
End If
End Forall
Set entry = viewnav.GetNextDocument(entry)
Wend
For i=0 To (column-1)
Call Me.autoFit(Sheet,array(i))
Next
Private Function doColumnExport (viewcol As NotesViewColumn, includeHidden As Boolean, IncludeIcons As Boolean, includeColors As Boolean) As Boolean
Dim isHiddenOK As Boolean
Dim isIconOK As Boolean
Dim isColorOK As Boolean
isHiddenOK = (viewcol.isHidden And IncludeHidden) Or Not viewcol.isHidden
isIconOK = (viewcol.isIcon And IncludeIcons) Or Not (viewcol.isIcon)
isColorOK = True
doColumnExport = isHiddenOK And isIconOK And isColorOK
Public Function autoFit(Sheet As Variant,col As String)
xlApp.Workbooks(1).Worksheets(Sheet).Columns(col+":"+col).EntireColumn.AutoFit
End Class
测试程序调用的代理代码如下：
Sub Initialize
Dim view As NotesView
Dim excelfilepath As String
Dim Sheet As Variant
Dim OffsetX As Integer
Dim OffsetY As Integer
Dim isWithHeader As Boolean
Dim includeIcons As Boolean
Dim includeColors As Boolean
Dim includeHidden As Boolean
Dim session As New NotesSession
Dim currdb As NotesDatabase
Const Font_Style = "Bold"
Const Font_Size =12
Const Font_Color =5
Set currdb=session.CurrentDatabase
Sheet = 1
OffsetX = 1
OffsetY = 1
isWithHeader = True
includeIcons = True
includeColors = True
includeHidden = True
excelfilepath = "" ' create an empty excel file
'Set view = ws.CurrentView.View
Set view=currdb.GetView("chunainfo")
Set report= New ExcelHelper("", True)
'Call report.setCellFont(1, 2, 2, Font_Style, Font_Size, Font_Color)
Call report.setRowFont(1, 2, Font_Style, Font_Size, Font_Color)
Call report.exportNotesView(view, Sheet, OffsetX, OffsetY, isWithheader, includeIcons, includeColors, includeHidden)
Call report.exportNotesView(view, 2, OffsetX, OffsetY, isWithheader, includeIcons, includeColors, includeHidden)
Call report.setVisibility(True)
Call report.setSheetName(Sheet,"请假单")
Call report.setSheetName(2,"出差报核单")
Msgbox "成功导出报表"
End Sub
该类还有很多不完善的地方，一点一点慢慢来吧。
本文转自生鱼片博客园博客，原文链接：http://www.cnblogs.com/carysun/archive/2008/08/08/DominoExcel.html，如需转载请自行联系原作者