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_USER\Software\Kingsoft\Office\Et\Addins\Work.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
周报：
月报：
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 出错
弹出的错误信息：
