开发可复用的从Domino中导出数据到Excel的类

本文介绍了一款基于Domino平台的简易Excel报表生成工具类,该工具类能够创建、编辑并保存Excel文件,支持设置单元格内容、颜色、字体等属性,并提供了导出Notes视图数据到Excel的功能。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

在domino开发中我们不可避免的要和报表打交道,一般就是生成各种Excel报表,本人主要为了自己在开发中方便,简单实现了一个基本类,现在功能有限,当然这个类我慢慢的根据以后遇到的需求逐渐完善。

None.gifConst EXCEL_APPLICATION        = "Excel.application"
None.gif
None.gif
Private Const BASEERROR                                                = 1200
None.gif
'Private Const ERROR_NOSUCHCELL                            = BASEERROR + 0
None.gif'
Private Const ERRORTEXT_NOSUCHCELL                    = "Excel Report - Could not get data from cell."
None.gif

None.gif
Const REG_97            = "Software\\Microsoft\\Office\\8.0\\Common\\InstallRoot"                    'Registry Key Office 97
None.gif
Const REG_2000        = "Software\\Microsoft\\Office\\9.0\\Common\\InstallRoot"                    'Registry Key Office 2000
None.gif
Const REG_XP            = "Software\\Microsoft\\Office\\10.0\\Common\\InstallRoot"                    'Registry Key Office XP
None.gif
Const REG_2003        ="Software\\Microsoft\\Office\\11.0\\Common\\InstallRoot"                    'Registry Key Office 2003
None.gif

None.gif
Const NAME_97        = "Office 97"
None.gif
Const NAME_2000        = "Office 2000"
None.gif
Const NAME_XP        = "Office XP"
None.gif
Const NAME_2003        = "Office 2003"
None.gif
ExpandedBlockStart.gifContractedBlock.gif
Class ExcelHelperClass ExcelHelper
InBlock.gif    
InBlock.gif   
Private xlApp As Variant                    ' Application object
InBlock.gif
    Private strFilePath As String    
InBlock.gif    
ExpandedSubBlockStart.gifContractedSubBlock.gif   
Sub new()Sub new(xlFilename As String, isVisible As Boolean)
InBlock.gif       
On Error Goto GeneralError        
InBlock.gif       
Set xlApp = CreateObject(EXCEL_APPLICATION)        ' open the application
InBlock.gif
        xlApp.Workbooks.Add xlFilename                            ' create an Excel workbook
InBlock.gif
        xlApp.Visible = isVisible                                            ' make it visible (or not)
InBlock.gif
        strFilePath = xlFilename                                            ' store the filename       
InBlock.gif
        Goto ExitSub
InBlock.gif        
InBlock.gifGeneralError:
InBlock.gif       
If Not (xlApp Is Nothing) Then xlApp.quit                    ' quit, if there is an error
InBlock.gif
        Resume ExitSub        
InBlock.gifExitSub:
ExpandedSubBlockEnd.gif   
End Sub
    
InBlock.gif    
ExpandedSubBlockStart.gifContractedSubBlock.gif   
Public Function save()Function save
InBlock.gif        xlApp.ActiveWorkbook.SaveAs( strFilePath )
ExpandedSubBlockEnd.gif   
End Function
    
InBlock.gif    
ExpandedSubBlockStart.gifContractedSubBlock.gif   
Public Function saveAs()Function saveAs(newFilename)
InBlock.gif        xlApp.ActiveWorkbook.SaveAs( newFileName )
ExpandedSubBlockEnd.gif   
End Function
    
InBlock.gif    
ExpandedSubBlockStart.gifContractedSubBlock.gif   
Public Function setCell()Function setCell( Sheet As Variant , row As Integer , column As Variant , value As Variant )
InBlock.gif        xlApp.Workbooks(
1).Worksheets( Sheet ).Cells( row , column ).Value = value
ExpandedSubBlockEnd.gif   
End Function

InBlock.gif    
ExpandedSubBlockStart.gifContractedSubBlock.gif   
Public Function getCell()Function getCell( Sheet As Variant , row As Integer , column As Variant ) As String
InBlock.gif       
On Error Goto GeneralError
InBlock.gif        getCell
= xlApp.Workbooks(1).Worksheets( Sheet ).Cells( row , column ).Value
InBlock.gif       
Goto ExitSub        
InBlock.gifGeneralError:
InBlock.gif        getCell
= ""
InBlock.gif       
Resume ExitSub        
InBlock.gifExitSub:        
ExpandedSubBlockEnd.gif   
End Function
    
InBlock.gif    
ExpandedSubBlockStart.gifContractedSubBlock.gif   
Public Function quit()Function quit
InBlock.gif       
If Not (xlApp Is Nothing) Then
InBlock.gif            xlApp.Quit
InBlock.gif           
Set xlApp = Nothing    
InBlock.gif       
End If
ExpandedSubBlockEnd.gif   
End Function
    
InBlock.gif    
ExpandedSubBlockStart.gifContractedSubBlock.gif   
Public Function setVisibility()Function setVisibility(isVisible As Boolean)
InBlock.gif       
If (isVisible And Not xlApp.Visible)     Then     xlApp.Visible = True
InBlock.gif       
If (Not isVisible And xlApp.Visible)    Then        xlApp.Visible = False
ExpandedSubBlockEnd.gif   
End Function

InBlock.gif    
ExpandedSubBlockStart.gifContractedSubBlock.gif   
Public Function setSheetName()Function setSheetName(Sheet As Variant,sheetName As String)
InBlock.gif        xlApp.Workbooks(
1).Worksheets( Sheet ).Select
InBlock.gif        xlApp.Workbooks(
1).Worksheets( Sheet ).Name=sheetName
ExpandedSubBlockEnd.gif   
End Function

InBlock.gif    
ExpandedSubBlockStart.gifContractedSubBlock.gif   
Public Function setCellColor()Function setCellColor(Sheet As Variant, row As Integer, column As Variant, innercolor As Variant)
InBlock.gif       
On Error Goto GeneralError        
InBlock.gif       
If Cstr(innercolor) <> "" Then
InBlock.gif            xlApp.Workbooks(
1).Worksheets( Sheet ).Cells( row , column ).Interior.ColorIndex = innercolor    
InBlock.gif       
End If        
InBlock.gif       
Goto ExitSub        
InBlock.gifGeneralError:
InBlock.gif       
Resume ExitSub        
InBlock.gifExitSub:
ExpandedSubBlockEnd.gif   
End Function
    
InBlock.gif    
ExpandedSubBlockStart.gifContractedSubBlock.gif   
Public Function setCellFont()Function setCellFont(Sheet As Variant, row As Integer, column As Variant, style As Variant, size As Variant, color As Variant)
InBlock.gif       
On Error Goto GeneralError        
InBlock.gif       
If Cstr(style) <> "" Then 
InBlock.gif            xlApp.Workbooks(
1).Worksheets( Sheet ).Cells( row , column ).Font.FontStyle         = style
InBlock.gif       
End If
InBlock.gif        
InBlock.gif       
If Cstr(size) <> "" Then
InBlock.gif            xlApp.Workbooks(
1).Worksheets( Sheet ).Cells( row , column ).Font.Size            = size
InBlock.gif       
End If
InBlock.gif        
InBlock.gif       
If Cstr(color) <> "" Then
InBlock.gif            xlApp.Workbooks(
1).Worksheets( Sheet ).Cells( row , column ).Font.ColorIndex     = color
InBlock.gif       
End If        
InBlock.gif        
InBlock.gif       
Goto ExitSub
InBlock.gif        
InBlock.gifGeneralError:
InBlock.gif       
Resume ExitSub        
InBlock.gifExitSub:
ExpandedSubBlockEnd.gif   
End Function
    
InBlock.gif    
ExpandedSubBlockStart.gifContractedSubBlock.gif   
Public Function setRowFont()Function setRowFont(Sheet As Variant, row As Integer,  style As Variant, size As Variant, color As Variant)
InBlock.gif       
On Error Goto GeneralError        
InBlock.gif       
Dim rowpara As String
InBlock.gif        rowpara
=Cstr(row)+":"+Cstr(row)
InBlock.gif        
InBlock.gif       
If Cstr(style) <> "" Then 
InBlock.gif            xlApp.Workbooks(
1).Worksheets( Sheet ).Rows(rowpara).Select
InBlock.gif            xlApp.Selection.Font.FontStyle    
= style
InBlock.gif       
End If
InBlock.gif        
InBlock.gif       
If Cstr(size) <> "" Then
InBlock.gif            xlApp.Workbooks(
1).Worksheets( Sheet ).Rows(rowpara).Select
InBlock.gif            xlApp.Selection.Font.Size   
= size
InBlock.gif       
End If
InBlock.gif        
InBlock.gif       
If Cstr(color) <> "" Then
InBlock.gif            xlApp.Workbooks(
1).Worksheets( Sheet ).Rows(rowpara).Select
InBlock.gif            xlApp.Selection.Font.ColorIndex
= color
InBlock.gif       
End If
InBlock.gif        
InBlock.gif       
Goto ExitSub        
InBlock.gifGeneralError:
InBlock.gif       
Resume ExitSub        
InBlock.gifExitSub:
ExpandedSubBlockEnd.gif   
End Function
    
InBlock.gif    
ExpandedSubBlockStart.gifContractedSubBlock.gif   
Public Function getVersion()Function getVersion() As String        
InBlock.gif       
On Error Goto GeneralError        
InBlock.gif       
Dim formula As String
InBlock.gif       
Dim SWVersion As String
InBlock.gif       
Dim Versions List As String
InBlock.gif       
Dim v As Variant        
InBlock.gif        
InBlock.gif        Versions(NAME_97)       
= REG_97
InBlock.gif        Versions(NAME_2000)   
= REG_2000
InBlock.gif        Versions(NAME_XP)       
= REG_XP
InBlock.gif        Versions(NAME_2003)   
= REG_2003    
InBlock.gif        
InBlock.gif        Forall vers
In Versions
InBlock.gif            formula$
= | (@RegQueryValue("HKEY_LOCAL_MACHINE"; "| & vers & |";"Path")) |
InBlock.gif            v
= Evaluate( formula$ )
InBlock.gif           
If v(0) <> "" Then
InBlock.gif                getVersion
= Listtag(vers)
InBlock.gif               
Goto ExitSub
InBlock.gif           
End If
InBlock.gif       
End Forall
InBlock.gif        
InBlock.gif        getVersion
= ""        
InBlock.gif       
Goto ExitSub
InBlock.gif        
InBlock.gifGeneralError:        
InBlock.gif        getVersion
= ""
InBlock.gif       
Resume ExitSub        
InBlock.gifExitSub:
ExpandedSubBlockEnd.gif   
End Function
    
InBlock.gif    
ExpandedSubBlockStart.gifContractedSubBlock.gif   
Public Function exportNotesView()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)
InBlock.gif       
Dim viewnav As NotesViewNavigator
InBlock.gif       
Dim entry As NotesViewEntry
InBlock.gif       
Dim viewcolumns As Variant
InBlock.gif       
Dim column As Integer
InBlock.gif       
Dim row As Integer        
InBlock.gif       
Dim i As Integer
InBlock.gif       
Dim array(0 To 9) As String
InBlock.gif        array(
0)="A" 
InBlock.gif        array(
1)="B"  
InBlock.gif        array(
2)="C" 
InBlock.gif        array(
3)="D" 
InBlock.gif        array(
4)="E" 
InBlock.gif        array(
5)="F" 
InBlock.gif        array(
6)="G" 
InBlock.gif        array(
7)="H" 
InBlock.gif        array(
8)="I" 
InBlock.gif        array(
9)="J"         
InBlock.gif        
InBlock.gif       
Set viewnav     = view.CreateViewNav()
InBlock.gif       
Set entry        = viewnav.GetFirstDocument()
InBlock.gif        viewcolumns   
= view.Columns
InBlock.gif        row                
= OffsetRow + 1
InBlock.gif        column            
= OffsetCol + 1        
InBlock.gif        
InBlock.gif       
If isWithHeader Then
InBlock.gif            Forall vc
In viewcolumns
InBlock.gif               
Call Me.setCell(Sheet, row, column, vc.title)    
InBlock.gif                column
= column + 1
InBlock.gif           
End Forall
InBlock.gif       
End If            
InBlock.gif        
InBlock.gif       
While Not (entry Is Nothing)
InBlock.gif            row            
= row + 1
InBlock.gif            column        
= OffsetCol + 1
InBlock.gif            Forall cv
In entry.ColumnValues
InBlock.gif               
If doColumnExport(viewcolumns(column - OffsetCol - 1), includeHidden, IncludeIcons, includeColors) Then
InBlock.gif                   
Call Me.setCell(Sheet, row, column, Cstr(cv))    
InBlock.gif               
End If
InBlock.gif                column
= column + 1
InBlock.gif           
End Forall            
InBlock.gif           
Set entry = viewnav.GetNextDocument(entry)
InBlock.gif        Wend        
InBlock.gif        
InBlock.gif       
For i=0 To  (column-1
InBlock.gif           
Call Me.autoFit(Sheet,array(i))            
InBlock.gif       
Next    
InBlock.gif        
ExpandedSubBlockEnd.gif   
End Function

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值