VSTO自定义VBE右键菜单

wpxxsyzx

1. <p>VS中可以快速插入常用的代码段，模仿之，在VBA中快速添加循环语句，条件语句等，代码如下；为了熟悉Advanced Installers，用其制作了安装程序，附件就是，请右击以管理员身份运行该安装程序</p><p>
   
2. </p><p>Imports Microsoft.Office.Core
   
3. Public Class ThisAddIn
   
4.     Public objBtns(18) As CommandBarButton
   
5.     Public objButton As CommandBarButton
   
6.     Dim strCaption() = {"If...End If", "If...Else...End If", "If...ElseIf...Else...End If", "Select Case语句", "#If...#Else...#End If",
   
7.            "For...Next", "For Each...Next", "DO While...Loop", "DO Until...Loop", "DO...Loop Until", "DO...Loop While",
   
8.           "添加引用", "声明变量", "获取字段名", "连接工作薄", "连接文本文件", "查询工作表", "查询工作表区域", "查询其他工作薄中的工作表"}
   
9.     Private Sub ThisAddIn_Startup() Handles Me.Startup
   
10.         Application.VBE.CommandBars("Code Window").Reset()
    
11.         With Application.VBE.CommandBars("Code Window").Controls.Add（MsoControlType.msoControlPopup，,, 1, True)
    
12.             .Caption = "插入代码段"
    
13.             With .Controls.add(MsoControlType.msoControlPopup,,,, True)
    
14.                 .Caption = "条件语句"
    
15.                 For i As Integer = 0 To 4
    
16.                     objButton = .Controls.add(MsoControlType.msoControlButton,,,, True)
    
17.                     objButton.Caption = strCaption(i)
    
18.                     AddHandler objButton.Click, AddressOf objButtonClick
    
19.                     objBtns(i) = objButton
    
20.                 Next
    
21.             End With
    
22.             With .Controls.add(MsoControlType.msoControlPopup,,,, True)
    
23.                 .Caption = "循环语句"
    
24.                 For i As Integer = 5 To 10
    
25.                     objButton = .Controls.add(MsoControlType.msoControlButton,,,, True)
    
26.                     objButton.Caption = strCaption(i)
    
27.                     AddHandler objButton.Click, AddressOf objButtonClick
    
28.                     objBtns(i) = objButton
    
29.                 Next
    
30.             End With
    
31.             With .Controls.add(MsoControlType.msoControlPopup,,,, True)
    
32.                 .Caption = "ADO相关"
    
33.                 For i As Integer = 11 To 18
    
34.                     objButton = .Controls.add(MsoControlType.msoControlButton,,,, True)
    
35.                     objButton.Caption = strCaption(i)
    
36.                     AddHandler objButton.Click, AddressOf objButtonClick
    
37.                     objBtns(i) = objButton
    
38.                 Next
    
39.             End With
    
40.         End With
    
41.     End Sub
    
42. 
    
43.     Private Sub ThisAddIn_Shutdown() Handles Me.Shutdown
    
44. 
    
45.     End Sub
    
46. 
    
47.     Private Sub objButtonClick(Ctrl As CommandBarButton, ByRef CancelDefault As Boolean)
    
48.         Dim strAdd As String
    
49.         Select Case Ctrl.Caption
    
50.             Case strCaption(0)
    
51.                 strAdd = "If True Then" & vbCrLf & vbCrLf & "End If"
    
52.             Case strCaption(1)
    
53.                 strAdd = "If True Then" & vbCrLf & vbCrLf & "Else" & vbCrLf & vbCrLf & "End If"
    
54.             Case strCaption(2)
    
55.                 strAdd = "If True Then" & vbCrLf & vbCrLf & "ElseIf False Then" & vbCrLf & vbCrLf & "Else" & vbCrLf & vbCrLf & "End If"
    
56.             Case strCaption(3)
    
57.                 strAdd = "Select Case Value" & vbCrLf & "Case Value1" & vbCrLf & vbCrLf & "Case Value2" & vbCrLf & vbCrLf & "Case Else" & vbCrLf & vbCrLf & "End Select"
    
58.             Case strCaption(4)
    
59.                 strAdd = "#If True Then" & vbCrLf & vbCrLf & "#Else" & vbCrLf & vbCrLf & "#End If"
    
60.             Case strCaption(5)
    
61.                 strAdd = "For i = 1 To 10" & vbCrLf & vbCrLf & "Next i"
    
62.             Case strCaption(6)
    
63.                 strAdd = "For Each item In collectionObject" & vbCrLf & vbCrLf & "Next item"
    
64.             Case strCaption(7)
    
65.                 strAdd = "Do Until False" & vbCrLf & vbCrLf & "Loop"
    
66.             Case strCaption(8)
    
67.                 strAdd = "Do While True" & vbCrLf & vbCrLf & "Loop"
    
68.             Case strCaption(9)
    
69.                 strAdd = "Do" & vbCrLf & vbCrLf & "Loop Until False"
    
70.             Case strCaption(10)
    
71.                 strAdd = "Do" & vbCrLf & vbCrLf & "Loop While True"
    
72.             Case strCaption(11)
    
73.                 Application.VBE.ActiveVBProject.References.AddFromGuid("{B691E011-1797-432E-907A-4D8C69339129}", 6, 1)
    
74.             Case strCaption(12)
    
75.                 strAdd = "Dim objConn As New ADODB.Connection" & vbCrLf & "Dim objRst As New ADODB.Recordset" & vbCrLf & "Dim strSql As String" &
    
76.                     vbCrLf & vbCrLf & "objRst.Close" & vbCrLf & "objConn.Close" & vbCrLf & "Set objRst = Nothing" & vbCrLf & "Set objConn = Nothing"
    
77.             Case strCaption(13)
    
78.                 strAdd = "For i = 0 To objRst.Fields.Count - 1" & vbCrLf & "工作表名.Cells(1, i + 1) = objRst.Fields(i).Name" & vbCrLf & "Next i"
    
79.             Case strCaption(14)
    
80.                 strAdd = "objConn.Open " & """provider=microsoft.ace.oledb.12.0;extended properties='excel 12.0;hdr=yes;IMEX=1';data source=""" & " & " & "文件名及完整路径"
    
81.             Case strCaption(15)
    
82.                 strAdd = "objConn.Open " & """provider=microsoft.ace.oledb.12.0;extended properties='text;FMT=DELIMITED';data source=""" & " & " & "文本文件路径"
    
83.             Case strCaption(16)
    
84.                 strAdd = "strSql = " & """select * from [工作表名称$]"""
    
85.             Case strCaption(17)
    
86.                 strAdd = "strSql = " & """select * from [工作表名称$A1:G100]"""
    
87.             Case strCaption(18)
    
88.                 strAdd = "strSql = " & """select * from [Excel 8.0;Database=""" & " & 文件名及完整路径 & " & """].[Sheet1$a:b]"""
    
89.         End Select
    
90.         Application.VBE.ActiveCodePane.CodeModule.AddFromString(strAdd)
    
91.     End Sub
    
92. End Class
    
93. </p>

复制代码

yf_home

测试了一下，好像不行，加载错误！

wpxxsyzx

什么情况，没在其他机器上测试，你是指安装程序错误，还是自己做项目出错

yf_home

wpxxsyzx 发表于 2018-7-16 08:35
什么情况，没在其他机器上测试，你是指安装程序错误，还是自己做项目出错

无法加载出菜单，

lipton

关注,我的机子运行正常。
环境:
win7 64位 office2010 64位，.NET4.0

wpxxsyzx

vsto总是这样，研究不透啊

huang1314wei

表示支持一下，win7下测试安装也是出错，安装office tools出错