标签:
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
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
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、 通过VB制作work.dll动态库
2、 制作注册文件work.reg
3、 注册文件:双击work.reg;在运行框中输入:regsvr32 …/work.dll
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
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
访问的API地址:http://115.28.150.92:80/
config_access_key= e44e560940e5a0a180948ef814804a91
config_secret_key=5792c3964094e0be8077ceb0f145f2e7
周报:
月报:
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)
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
周报点击事件
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
1、 不要擅自修改周报的报表格式,否则会导致导出的数据出错
2、 周报的各行依次是:标题、周一天的具体工作内容(不要留有空行,否则解析错误)、周报总结和计划。
3、 周报最后三行必须是:本周工作总结、下周工作计划、本人建议(一般情况,本人建议为空,但是也不能将其删除)
4、 获取JSon字符串后,需要将其空格剔除,否则不能xml解析
以注册文件的方式,写批处理文件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
1、加载项未成功
原因:批处理注册文件失败,原因权限不够
对策:分步写注册表、注册文件
新问题:…已加载,但对DllRegisterServer的调用失败。
原因:操作用户的权限不够
新对策:以管理员身份打开“命令提示符”,输入“regsvr32 …\work.dll”,显示注册成功
2、获取个人周报的数据不全
显示XML解析错误
3、http请求失败,获取用户基本信息出错
objHTTP.Open "GET", url, False 出错
弹出的错误信息:
标签:
原文地址:http://www.cnblogs.com/yuanloo/p/4329906.html