在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 ) End Function 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 GeneralError: getCell = "" Resume ExitSub ExitSub: End Function Public Function quit If Not (xlApp Is Nothing) Then xlApp.Quit Set xlApp = Nothing End If End Function 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 End Function Public Function setSheetName(Sheet As Variant,sheetName As String) xlApp.Workbooks(1).Worksheets( Sheet ).Select xlApp.Workbooks(1).Worksheets( Sheet ).Name=sheetName End Function Public Function setCellColor(Sheet As Variant, row As Integer, column As Variant, innercolor As Variant) On Error Goto GeneralError If Cstr(innercolor) <> "" Then xlApp.Workbooks(1).Worksheets( Sheet ).Cells( row , column ).Interior.ColorIndex = innercolor End If Goto ExitSub GeneralError: Resume ExitSub ExitSub: End Function Public Function setCellFont(Sheet As Variant, row As Integer, column As Variant, style As Variant, size As Variant, color As Variant) On Error Goto GeneralError If Cstr(style) <> "" Then xlApp.Workbooks(1).Worksheets( Sheet ).Cells( row , column ).Font.FontStyle = style End If If Cstr(size) <> "" Then xlApp.Workbooks(1).Worksheets( Sheet ).Cells( row , column ).Font.Size = size End If If Cstr(color) <> "" Then xlApp.Workbooks(1).Worksheets( Sheet ).Cells( row , column ).Font.ColorIndex = color End If Goto ExitSub GeneralError: Resume ExitSub ExitSub: End Function Public Function setRowFont(Sheet As Variant, row As Integer, style As Variant, size As Variant, color As Variant) On Error Goto GeneralError Dim rowpara As String rowpara=Cstr(row)+":"+Cstr(row) If Cstr(style) <> "" Then xlApp.Workbooks(1).Worksheets( Sheet ).Rows(rowpara).Select xlApp.Selection.Font.FontStyle = style End If If Cstr(size) <> "" Then xlApp.Workbooks(1).Worksheets( Sheet ).Rows(rowpara).Select xlApp.Selection.Font.Size = size End If If Cstr(color) <> "" Then xlApp.Workbooks(1).Worksheets( Sheet ).Rows(rowpara).Select xlApp.Selection.Font.ColorIndex = color End If Goto ExitSub GeneralError: Resume ExitSub ExitSub: End Function Public Function getVersion() As String On Error Goto GeneralError 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 = "" Goto ExitSub GeneralError: getVersion = "" Resume ExitSub ExitSub: End Function 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 column = column + 1 End Forall Set entry = viewnav.GetNextDocument(entry) Wend For i=0 To (column-1) Call Me.autoFit(Sheet,array(i)) Next End Function 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 End Function Public Function autoFit(Sheet As Variant,col As String) xlApp.Workbooks(1).Worksheets(Sheet).Columns(col+":"+col).EntireColumn.AutoFit End Function 
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