关于在Lotus里应用Excel的技术很多,本人根据自己所做体会到,在 C/S下应用Excel 的技术难点实在不多,最主要的就是录制宏的应用和句柄的取得。
以下代码为本人使用做为例子的代码,并不是固定的,大家可以根据自己的需要更改,以下编程的方法也不是最好的,对于高手来说,这些可能没有多大用处,在此仅供初学者参考。
一、 对于嵌入式Excel,表单中应至少包括以下几个域:$OLEObjProgID(值为:"Excel.Sheet")、$OLEObjField(值为用来做Excel容器的RTF域名称如:”body”)、$OLEObjRichTextField(值为用来传递Excel内容的RTF域名称如:"OLEBody")、RTF域(Body和OLEBOdy[可选])。
二、 在PostOpen里打开的时候激活并初始化Excel;
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'打开文档时激活文档
'如果为新建,作者进行修改不保留痕迹
'编辑状态另行控制
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Sub Postopen(Source As Notesuidocument)
'On Error Resume Next
'当新建时,不执行
‘\\*定义并初始化
Dim session As New NotesSession
Dim db As NotesDatabase
Dim w As New notesuiworkspace
Dim View As NotesView,ZbView As NotesView
Dim doc As notesdocument
Dim rtitem As NotesRichTextItem
Dim embed As NotesEmbeddedObject
Dim sOleField As String
Dim excelWorkbook As Variant
Dim objapp As Variant
Dim CurWindow As Variant
Set doc = source.document
Dim objDoc As Variant
Set db = session.CurrentDatabase
source.RefreshHideFormulas
‘\\*初始化结束
If doc.hasitem("$OLEObjProgID") Then
sOleField = doc.~$OLEObjField(0)
If source.IsNewDoc Then’\\新建时执行
doc.~$OLEVersion = "46"
source.gotofield(sOleField)
Set objDoc=Source.CreateObject("OLEObject",doc.~$OLEObjProgID(0),"")’\\创建Excel.Sheet对象
Set objapp=objDoc.Application’\\取得APP句柄
objapp.ScreenUpdating=False ‘\\在初始化完成之前不刷新屏幕
Set excelSheet = objDoc .Activesheet ‘\\得到当前活动的Sheet
‘\\设置菜单是否可见
If objDoc.CommandBars("Standard").Visible = True Then
objDoc.CommandBars("Standard").Visible = False
objDoc.CommandBars("Formatting").Visible = False
objDoc.CommandBars("Drawing").Visible = False
End If
‘\\调用新建初始化函数NewWritInfoToExcel
Call NewWritInfoToExcel(objDoc,excelSheet)
‘\\初始化完毕,刷新屏幕(该功能主要为了避免在初始化过程中屏幕抖动)
objapp.ScreenUpdating=True
‘\\冻结单元格B5
excelSheet.Range("B5").Select
Set CurWindow=objapp.ActiveWindow
CurWindow.FreezePanes = True
Else
If (source.InPreviewPane) Then Exit Sub
' If the user is not an author of the document we have to launch out of place
If (doc.HasEmbedded) Then
Set rtitem = doc.GetFirstItem(sOleField)
Set embed = rtitem.EmbeddedObjects(0)
' see if this is an older document
If doc.~$OLEVersion(0) <> "46" Then
'embed.FitToWindow = True
' Call NewWritInfoToExcel(oleobject)
'Else
Set wordApplication = source.GetObject(embed.name)
Set objapp=wordApplication.Application
objapp.ScreenUpdating=False
'Set excelWorkbook = excelApplication.ThisWorkbook
Set excelSheet =wordApplication .Activesheet
' Call ExputToExcel(excelSheet)
If wordApplication.CommandBars("Standard").Visible = True Then
wordApplication.CommandBars("Standard").Visible = False
wordApplication.CommandBars("Formatting").Visible = False
wordApplication.CommandBars("Drawing").Visible = False
End If
objapp.ScreenUpdating=True
excelSheet.Range("B5").Select
Set CurWindow=objapp.ActiveWindow
CurWindow.FreezePanes = True
'Set oleobject = embed.Activate(True)
End If
Else
If (source.EditMode) Then
source.gotofield(sOleField)
'Call source.CreateObject("OLEObject",doc.~$OLEObjProgID(0),"")
Set objDoc=Source.CreateObject("OLEObject",doc.~$OLEObjProgID(0),"")
Set objapp=objDoc.Application
objapp.ScreenUpdating=False
Set excelSheet = objDoc .Activesheet
If objDoc.CommandBars("Standard").Visible = True Then
objDoc.CommandBars("Standard").Visible = False
objDoc.CommandBars("Formatting").Visible = False
objDoc.CommandBars("Drawing").Visible = False
End If
Call NewWritInfoToExcel(objDoc,excelSheet)
objapp.ScreenUpdating=True
excelSheet.Range("B5").Select
Set CurWindow=objapp.ActiveWindow
CurWindow.FreezePanes = True
End If
End If
End If
End If
End Sub
‘\\在以上代码中很多功能都可以根据宏录制来得到命令然后配与正确的句柄既可实现
‘\\或则参考VBA For Microsoft Excel 都会有很大的帮助
三、 Excel初始化[Call NewWritInfoToExcel(objDoc,excelSheet)]
excelSheet.Cells(1,1).Value = ""
excelSheet.Cells(3,1).Value = “"
……
‘\\设置单元格格式
With excelSheet.Columns("A")
.ColumnWidth = 20
.WrapText = True
.HorizontalAlignment = -4108
.VerticalAlignment= -4108
End With
Dim l As Integer
For l=0 To i
'设置EXCEL格式
With excelSheet.Columns(GetCell(l))
.ColumnWidth = 10
.WrapText = True
.HorizontalAlignment = -4108
.VerticalAlignment= -4108
End With
Next
'\\以下为合并单元格
excelSheet.Range("A3:A5").Merge
'\\合并结束
With excelSheet.Range("A1:"+C+"1").font
.size=14
.Bold=True
End With
excelSheet.Range("A2:"+C+"2").Select
With excelSheet.Range("A2:"+C+"2")
.ColumnWidth = 10
.HorizontalAlignment = -4152
End With
excelSheet.Range("A1:"+C+"1").Merge
excelSheet.Range("A2:"+C+"2").Merge
excelSheet.Columns("A:"+C).Select
excelSheet.Columns("A:"+C).EntireColumn.AutoFit
excelSheet.Range("A6:"+C+Cstr(num-1)).Select
excelSheet.Range("A6:"+C+Cstr(num-1)).Borders(5).LineStyle = -4142
excelSheet.Range("A6:"+C+Cstr(num-1)).Borders(6).LineStyle = -4142
excelSheet.Rows("1:1").RowHeight =25
excelSheet.Rows("3:3").RowHeight =20
excelSheet.Rows("6:6").RowHeight =40
Dim k As Integer
For k=1 To num-5
With excelSheet.Range("A3:"+C+Cstr(num-k)).Borders(8)
.LineStyle = 1
.Weight = 2
.ColorIndex = -4105
End With
With excelSheet.Range("A3:"+C+Cstr(num-k)).Borders(7)
.LineStyle = 1
.Weight = 2
.ColorIndex = -4105
End With
With excelSheet.Range("A3:"+C+Cstr(num-k)).Borders(9)
.LineStyle = 1
.Weight = 2
.ColorIndex = -4105
End With
With excelSheet.Range("A3:"+C+Cstr(num-k)).Borders(10)
.LineStyle = 1
.Weight = 2
.ColorIndex = -4105
End With
With excelSheet.Range("A3:"+C+Cstr(num-k)).Borders(11)
.LineStyle = 1
.Weight = 2
.ColorIndex = -4105
End With
Next
With excelSheet.Range("A3:"+C+"5").Borders(12)
.LineStyle = 1
.Weight = 2
.ColorIndex = -4105
End With
Set SxDoc=Sxview.GetFirstDocument
While Not Sxdoc Is Nothing
'Msgbox sxdoc.txt_zrdw(0)
Set Sxdc=ZbView.GetAlldocumentsBykey(Sxdoc.txt_zrdw(0))
If Sxdc.count>0 Then
For o=1 To Sxdc.count
Set Printdoc=Sxdc.GetNthDocument(o)
'Msgbox Printdoc.txt_zrdw(0)
'Msgbox Printdoc.txt_Form(0)
If Printdoc.txt_Form(0)="1" Then
Call InitializeToExcel(excelSheet,Printdoc.Universalid,SumSx)
SumSx=SumSx+2
Else
|