WPS报表导出插件

1        VB开发WPS插件的步骤

1.1     启动程序

1.1.1      网络上的示例代码

Option Explicit

Implements IDTExtensibility2

Private Sub IDTExtensibility2_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)

On Error Resume Next '防错处理

'WPS的工具栏对象为 KSO.CommandBar(代表一个工具栏)

'WPS的工具栏集合为 KSO.CommandBars(代表所有的工具栏)

'我们可以用KSO.CommandBars提供的Add方法创建一个工具栏,如

Dim myComBar As KSO.CommandBar '定义一个工具栏对象

Application.CommandBars("我的自定义工具栏").Delete  '一般我们创建新工具栏前要把可能存在的同名工具栏删除

Set myComBar = Application.CommandBars.Add("我的自定义工具栏", ksoBarTop, , True) '创建一个工具栏

'Add方法的四个参数是:工具栏名称,位置,是否以新命令栏替换活动菜单栏,是否是临时命令栏,一般除了第一个名称外,其他三个参数如上设置即可

'好了,现在我们创建了一个工具栏,但是,工具栏只是一个容器,上面什么也没有,所以我们要在工具栏上创建按钮和弹出菜单:

Dim myPopup As KSO.CommandBarPopup '定义一个弹出菜单

Dim myBtn As KSO.CommandBarButton '定义一个按钮

Set myPopup = myComBar.Controls.Add(ksoControlPopup, , , , True) '创建一个弹出式菜单在工具栏myComBar上

myPopup.Caption = "我是工具栏上的弹出菜单" '设定弹出菜单的Caption属性,它将显示在界面上

Set myBtn = myComBar.Controls.Add(ksoControlButton, , , , True) '创建一个按钮在工具栏myComBar上

myBtn.Caption = "我是工具栏上的按钮" '设定按钮的Caption属性,它将显示在界面上

'现在工具栏上已经有了一个弹出菜单和一个按钮,但弹出菜单上什么也没有,我们现在在弹出菜单上创建两个按钮:

Set myBtn = myPopup.Controls.Add(ksoControlButton, , , , True) '创建一个按钮在弹出菜单myPopup上

myBtn.Caption = "我是弹出菜单上的按钮1"

Set myBtn = myPopup.Controls.Add(ksoControlButton, , , , True) '创建一个按钮在弹出菜单myPopup上

myBtn.Caption = "我是弹出菜单上的按钮2"

myComBar.Visible = True '最后设置新创建的工具栏的Visible属性为True,让其可见

'现在有了上面的代码作为模板,你可以做以下几件事件

'1.创建一个或多个工具栏

'2.在工具栏上创建一个或多个弹出菜单和按钮

'3.在弹出菜单上再创建一个或多个按钮

End Sub

Private Sub IDTExtensibility2_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)

End Sub

Private Sub IDTExtensibility2_OnStartupComplete(custom() As Variant)

End Sub

Private Sub IDTExtensibility2_OnAddInsUpdate(custom() As Variant)

End Sub

Private Sub IDTExtensibility2_OnBeginShutdown(custom() As Variant)

End Sub

1.1.2      初步调整的代码

Option Explicit

Private WithEvents btnNew1 As CommandBarButton

Private WithEvents btnNew2 As CommandBarButton

Private WithEvents btnNew3 As CommandBarButton

Implements IDTExtensibility2

Private Sub IDTExtensibility2_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)

On Error Resume Next '防错处理

'WPS的工具栏对象为 KSO.CommandBar(代表一个工具栏)

'WPS的工具栏集合为 KSO.CommandBars(代表所有的工具栏)

'我们可以用KSO.CommandBars提供的Add方法创建一个工具栏,如

Dim myComBar As KSO.CommandBar '定义一个工具栏对象

Application.CommandBars("我的自定义工具栏").Delete  '一般我们创建新工具栏前要把可能存在的同名工具栏删除

Set myComBar = Application.CommandBars.Add("我的自定义工具栏", ksoBarTop, , True) '创建一个工具栏

'Add方法的四个参数是:工具栏名称,位置,是否以新命令栏替换活动菜单栏,是否是临时命令栏,一般除了第一个名称外,其他三个参数如上设置即可

'好了,现在我们创建了一个工具栏,但是,工具栏只是一个容器,上面什么也没有,所以我们要在工具栏上创建按钮和弹出菜单:

Set btnNew1 = myComBar.Controls.Add

btnNew1.Caption = "导出周报"

Set btnNew2 = myComBar.Controls.Add

btnNew2.Caption = "导出周报"

Set btnNew3 = myComBar.Controls.Add

btnNew3.Caption = "配置"

myComBar.Visible = True '最后设置新创建的工具栏的Visible属性为True,让其可见

'现在有了上面的代码作为模板,你可以做以下几件事件

'1.创建一个或多个工具栏

'2.在工具栏上创建一个或多个弹出菜单和按钮

'3.在弹出菜单上再创建一个或多个按钮

End Sub

Private Sub IDTExtensibility2_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)

End Sub

Private Sub IDTExtensibility2_OnStartupComplete(custom() As Variant)

End Sub

Private Sub IDTExtensibility2_OnAddInsUpdate(custom() As Variant)

End Sub

Private Sub IDTExtensibility2_OnBeginShutdown(custom() As Variant)

End Sub

Private Sub btnNew1_Click(ByVal Ctrl As KSO.CommandBarButton, CancelDefault As Boolean)

MsgBox (1)

End Sub

Private Sub btnNew2_Click(ByVal Ctrl As KSO.CommandBarButton, CancelDefault As Boolean)

MsgBox (2)

End Sub

Private Sub btnNew3_Click(ByVal Ctrl As KSO.CommandBarButton, CancelDefault As Boolean)

MsgBox (3)

End Sub

1.2     注册文件

Windows Registry Editor Version 5.00

[HKEY_CURRENT_USERSoftwareKingsoftOfficeEtAddinsWork.Report]

"FriendlyName"="WPS加载项Demo"

"Description"="加载项"

"LoadBehavior"=d:00000003

"CommandLineSafe"=d:00000001

1.3     注册步骤

1、  通过VB制作work.dll动态库

2、  制作注册文件work.reg

3、  注册文件:双击work.reg;在运行框中输入:regsvr32 …/work.dll

2        VB开发WPS插件

2.1     VB添加工具栏

Public Sub 创建工具栏弹出菜单按钮()

On Error Resume Next '防错处理

'WPS的工具栏对象为 KSO.CommandBar(代表一个工具栏)

'WPS的工具栏集合为 KSO.CommandBars(代表所有的工具栏)

'我们可以用KSO.CommandBars提供的Add方法创建一个工具栏,如

Dim myComBar As KSO.CommandBar '定义一个工具栏对象

Application.CommandBars("我的自定义工具栏").Delete  '一般我们创建新工具栏前要把可能存在的同名工具栏删除

Set myComBar = Application.CommandBars.Add("我的自定义工具栏", ksoBarTop, , True) '创建一个工具栏

'Add方法的四个参数是:工具栏名称,位置,是否以新命令栏替换活动菜单栏,是否是临时命令栏,一般除了第一个名称外,其他三个参数如上设置即可

'好了,现在我们创建了一个工具栏,但是,工具栏只是一个容器,上面什么也没有,所以我们要在工具栏上创建按钮和弹出菜单:

Dim myPopup As KSO.CommandBarPopup '定义一个弹出菜单

Dim myBtn As KSO.CommandBarButton '定义一个按钮

Set myPopup = myComBar.Controls.Add(ksoControlPopup, , , , True) '创建一个弹出式菜单在工具栏myComBar上

myPopup.Caption = "我是工具栏上的弹出菜单" '设定弹出菜单的Caption属性,它将显示在界面上

Set myBtn = myComBar.Controls.Add(ksoControlButton, , , , True) '创建一个按钮在工具栏myComBar上

myBtn.Caption = "我是工具栏上的按钮" '设定按钮的Caption属性,它将显示在界面上

'现在工具栏上已经有了一个弹出菜单和一个按钮,但弹出菜单上什么也没有,我们现在在弹出菜单上创建两个按钮:

Set myBtn = myPopup.Controls.Add(ksoControlButton, , , , True) '创建一个按钮在弹出菜单myPopup上

myBtn.Caption = "我是弹出菜单上的按钮1"

Set myBtn = myPopup.Controls.Add(ksoControlButton, , , , True) '创建一个按钮在弹出菜单myPopup上

myBtn.Caption = "我是弹出菜单上的按钮2"

myComBar.Visible = True '最后设置新创建的工具栏的Visible属性为True,让其可见

'现在有了上面的代码作为模板,你可以做以下几件事件

'1.创建一个或多个工具栏

'2.在工具栏上创建一个或多个弹出菜单和按钮

'3.在弹出菜单上再创建一个或多个按钮

End Sub

2.2     VB解析XML

Sub ee()

Dim objXMLDom As New DOMDocument

    Dim objXMLNodeList As IXMLDOMNodeList

    Dim objXMLNode As IXMLDOMNode

    Dim document As New DOMDocument

   

    objXMLDom.async = False

    objXMLDom.validateOnParse = False

    Dim bSuccess As Boolean

    bSuccess = objXMLDom.Load("D:sample.xml")

    'bSuccess = objXMLDom.Load(str)

    MsgBox bSuccess

    MsgBox objXMLDom.xml

    Dim str As String

    str = objXMLDom.xml

   

    Dim objXMLNodeList2 As IXMLDOMNodeList

    Dim objXMLNode2 As IXMLDOMNode      

   document.loadXML str

   MsgBox document.xml

   

End Sub

3        导出报表的API

访问的API地址:http://115.28.150.92:80/

config_access_key= e44e560940e5a0a180948ef814804a91

config_secret_key=5792c3964094e0be8077ceb0f145f2e7

周报:

http://115.28.150.92:80/taskreports/get_taskweekreport?access_key=e44e560940e5a0a180948ef814804a91&secret_key=1a14605e4077eacb80812cc85cc4a120&user_id=5510f536409454a2803db85754686cb3&week_start=2014.41&week_end=2014.41

月报:

http://115.28.150.92:80/taskreports/get_taskmonthreport?access_key=e44e560940e5a0a180948ef814804a91&secret_key=5792c3964094e0be8077ceb0f145f2e7&user_id=2a446e0e40e01356801344a4a9a3af84&month_start=2014.9&month_end=2014.9

4        WPS表格开发遇到的问题

4.1     Run-time error ’91’

1)问题:在点击事件中添加下列代码

Dim fm As Form1

fm.show

将会报下面的错误

Run-time error ’91’

Object variable or with block variable not set(有一个对象变量定义了,但是没有设置)

2)对策:

修改代码如下

Dim fm As New Form1

fm.show

3)新问题:Run-time error ’406’

Non-modle forms cannot be display in this host application from an Active Dll,Active Control,or Property Page(不可以通过Active动态库、Active控件、属性页在宿主程序中显示非模态窗口)

4)新对策:修改为模态窗口

Dim fm As New Form1

fm.show(1)

4.2     修改了月报的样式,导不出数据结果。

4.2.1      判断是否有同名的Sheet

try: On Error GoTo catch

      '新建月报的表

    Set xlApp = GetObject(, "ET.Application")

    '判断当前是否有workbooks,有的话选择当前活动的,没有的话则新建一个

    If xlApp.Workbooks.Count > 0 Then

      Set xlBook = xlApp.ActiveWorkbook

    Else

      Set xlBook = xlApp.Workbooks.Add

    End If

   ' Dim i As Integer

   ' For i = 1 To xlBook.Worksheets.Count - 1

   ' xlBook.Worksheets(i).Delete

   ' Next

   ' Set xlSheet = xlBook.ActiveSheet

    Set xlSheet = xlBook.Sheets.Add

   xlSheet.Name = strSheetName

   NewMonthSheet = True

finally:

 MsgBox "quit"

  xlApp = Nothing

  Exit Function

  catch:

  MsgBox "新建工作簿出错"

  Resume finally

4.2.2      http获取信息

周报点击事件

Private Sub btnNew1_Click(ByVal Ctrl As KSO.CommandBarButton, CancelDefault As Boolean)

    '获取周报

    Dim bytData() As Byte

    Dim objHTTP As Object

    Dim url As String

 try: On Error GoTo catch

    url = "http://115.28.150.92:80/taskreports/get_taskweekreport?access_key=e44e560940e5a0a180948ef814804a91&secret_key=5792c3964094e0be8077ceb0f145f2e7&user_id=2a446e0e40e01356801344a4a9a3af84&week_start=2014.40&week_end=2014.40"

    Set objHTTP = CreateObject("MSXML2.XMLHTTP")

    objHTTP.Open "GET", url, False

    objHTTP.send

    If objHTTP.Status = 200 Then

        bytData = objHTTP.responseBody

        Debug.Print StrConv(bytData, vbUnicode)

        bytData = UTF8_Decode(bytData)

        'MsgBox (bytData)

        '解析Json串,必须先将Byte类型转换为string类型

        Dim ss As String

        ss = bytData

        Dim strXML

        strXML = ParseJson(ss)

       ' MsgBox (strXML)

       '解析周报

       ParseWeeklyXML (strXML)

    End If

   

finally:

     Set objHTTP = Nothing

     Exit Sub

catch:

     MsgBox "请求失败,请确认输入的请求信息有效"

     Resume finally

End Sub

4.3     导出周报的格式要求

1、  不要擅自修改周报的报表格式,否则会导致导出的数据出错

2、  周报的各行依次是:标题、周一天的具体工作内容(不要留有空行,否则解析错误)、周报总结和计划。

3、  周报最后三行必须是:本周工作总结、下周工作计划、本人建议(一般情况,本人建议为空,但是也不能将其删除)

4、  获取JSon字符串后,需要将其空格剔除,否则不能xml解析

5        插件部署测试

5.1     部署方式

以注册文件的方式,写批处理文件setup.bat

1、  注册日期控件。一般的机器是没有注册日期控件MSCOMCT2.OCX,判断机器的位数再注册日期控件

2、  安装WPS ET插件。分成两步:写注册表,注册动态库。

3、  批处理文件如下:

点击安装

@该插件实现在WPS ET导出NercOA报表

ECHO 注册VB的日期控件

if %processor_architecture%==x86 (echo 32位)

copy MSCOMCT2.OCX %windir%system32

else (echo 64位)

copy MSCOMCT2.OCX %windir%SysWOW64

regsvr32 MSCOMCT2.OCX /s

ECHO 请稍等

 

ECHO 安装WPS ET插件

regedit /s  WPSETPlugin.reg

ECHO 请稍等

 

ECHO 注册wps的动态链接库

regsvr32 work.dll /s

ECHO 请稍等

 

EXIT

5.2     出现的问题

1、加载项未成功

原因:批处理注册文件失败,原因权限不够

对策:分步写注册表、注册文件

新问题:…已加载,但对DllRegisterServer的调用失败。

原因:操作用户的权限不够

新对策:以管理员身份打开“命令提示符”,输入“regsvr32 …work.dll”,显示注册成功

2、获取个人周报的数据不全

显示XML解析错误

3、http请求失败,获取用户基本信息出错

objHTTP.Open "GET", url, False 出错

弹出的错误信息:

原文地址:https://www.cnblogs.com/yuanloo/p/4329906.html