• 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 出错

    弹出的错误信息:

  • 相关阅读:
    Windows 2008R2 安装PostgreSQL 11.6
    Redis-基础介绍
    SQL Server中的GAM页和SGAM页
    linux读写相关
    String 和 Stringbuild
    JVM(六)如何执行方法调用
    dubbo学习(三)实现细节
    dubbo学习(二)SPI
    spring boot
    MySQL学习(二十一)锁
  • 原文地址:https://www.cnblogs.com/yuanloo/p/4329906.html
Copyright © 2020-2023  润新知