中国IT动力,最新最全的IT技术教程
最新100篇 | 推荐100篇 | 专题100篇 | 排行榜 | 搜索 | 在线API文档
首 页 | 程序开发 | 操作系统 | 软件应用 | 图形图象 | 网络应用 | 精文荟萃 | 教育认证 | 硬件维护 | 未整理篇 | 站长教程
ASP JS PHP工程 ASP.NET 网站建设 UML J2EESUN .NET VC VB VFP 网络维护 数据库 DB2 SQL2000 Oracle Mysql
服务器 Win2000 Office C DreamWeaver FireWorks Flash PhotoShop 上网宝典 CorelDraw 协议大全 网络安全 微软认证
硬件维护  CPU  主板  硬盘  内存  显卡  显示器  键盘鼠标  声卡音箱  打印机  机箱电源  BIOS  网卡  C#  Java  Delphi  vs.net2005
  当前位置:> 程序开发 > 编程语言 > LOTUS > 开发心得
VBA for Excel
作者:未知 时间:2005-07-22 13:39 出处:Lotus中文技术站 责编:chinaitpower
              摘要:关于在Lotus里应用Excel的技术很多,本人根据自己所做体会到,在 C/S下应用Excel 的技术难点实在不多,最主要的就是录制宏的应用和句柄的取得。 以下代码为本人使用做为例子的代码,并不是固定的,大家可以根据自己的需要更改,以下编程的方法也不是最好的,对于高手来说,这些可能没有多大用处,在此仅供初学者参考。

关于在Lotus里应用Excel的技术很多,本人根据自己所做体会到,在 C/S下应用Excel 的技术难点实在不多,最主要的就是录制宏的应用和句柄的取得。

以下代码为本人使用做为例子的代码,并不是固定的,大家可以根据自己的需要更改,以下编程的方法也不是最好的,对于高手来说,这些可能没有多大用处,在此仅供初学者参考。

一、               对于嵌入式Excel,表单中应至少包括以下几个域:$OLEObjProgID(值为:"Excel.Sheet")、$OLEObjField(值为用来做Excel容器的RTF域名称如:”body”)、$OLEObjRichTextField(值为用来传递Excel内容的RTF域名称如:"OLEBody")、RTF(BodyOLEBOdy[可选])

二、               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

关闭本页
 
首页 | 投资与合作 | 服务条款 | 隐私政策 | 收藏本站 | 设为首页 | 新用户注册 | 免责声明 | 使用帮助
Copyright ©2005-2008 chinaitpower.com All rights reserved. www.chinaitpower.com 版权所有