在Visual Studio中开发Excel商务应用程序

VBA万岁

VBA万岁 发表于 2015-10-26 09:05
Module代码：

错误所在，单击自定义选项卡“专用等式”时，依次弹出如下提示（单击其中的“贷款”、|“年金”、“有效利率”、“开始计算”按钮及文本框中输入数字时也会报同样的错误）：

VBA万岁

VBA万岁 发表于 2015-10-26 09:19
错误所在，单击自定义选项卡“专用等式”时，依次弹出如下提示（单击其中的“贷款”、|“年金”、“有效 ...

附件如下：

VBA万岁

VBA万岁 发表于 2015-10-26 09:19
错误所在，单击自定义选项卡“专用等式”时，依次弹出如下提示（单击其中的“贷款”、|“年金”、“有效 ...

终于解决了，代码如下：
VBA（Module1）代码：

1. Public objRib As IRibbonUI
   
2. Public CalcType
   
3. Public Rate
   
4. Public Term
   
5. Public Payment
   
6. Public Amount
   
7.    
   
8. Sub RibLoad(ribbon As IRibbonUI)
   
9.     Set objRib = ribbon
   
10. End Sub
    
11. 
    
12. Sub GetControlID(control As IRibbonControl, pressed As Boolean)
    
13.     CalcType = control.id
    
14.     objRib.Invalidate
    
15. End Sub
    
16. 
    
17. Sub SelectedEquation(control As IRibbonControl, ByRef returnedVal)
    
18.     ' 基于当前的等式确定按下状态
    
19.     Select Case CalcType
    
20.         Case "Loan"
    
21.             If control.id = "Loan" Then
    
22.                 returnedVal = True
    
23.             Else
    
24.                 returnedVal = False
    
25.             End If
    
26.         Case "Annuity"
    
27.             If control.id = "Annuity" Then
    
28.                 returnedVal = True
    
29.             Else
    
30.                 returnedVal = False
    
31.             End If
    
32.         Case "EffectiveRate"
    
33.             If control.id = "EffectiveRate" Then
    
34.                 returnedVal = True
    
35.             Else
    
36.                 returnedVal = False
    
37.             End If
    
38.         Case Else
    
39.             returnedVal = False
    
40.     End Select
    
41. End Sub
    
42. 
    
43. Sub TermVisible(control As IRibbonControl, ByRef returnedVal)
    
44.     ' 应用程序不会使用该字段进行有效利率计算
    
45.     If CalcType = "EffectiveRate" Then
    
46.         returnedVal = False
    
47.     Else
    
48.         returnedVal = True
    
49.     End If
    
50.     'returnedVal1 = v1
    
51. End Sub
    
52. 
    
53. Sub PaymentVisible(control As IRibbonControl, ByRef returnedVal)
    
54.     ' 当处理年金计算时应用程序仅使用该字段
    
55.     If CalcType = "Annuity" Then
    
56.         returnedVal = True
    
57.     Else
    
58.         returnedVal = False
    
59.     End If
    
60.     'returnedVal2 = v2
    
61. End Sub
    
62. 
    
63. Sub AmountVisible(control As IRibbonControl, ByRef returnedVal)
    
64.     ' 应用程序不会使用该字段进行有效利率计算
    
65.     If CalcType = "EffectiveRate" Then
    
66.         returnedVal = False
    
67.     Else
    
68.         returnedVal = True
    
69.     End If
    
70.     'MsgBox returnedVal3
    
71.     'returnedVal3 = v3
    
72. End Sub
    
73. 
    
74. Sub GetDataEntryLabel(control As IRibbonControl, ByRef returnedVal)
    
75.     ' 通过计算类型的选择决定组标签
    
76.     Select Case CalcType
    
77.         Case "Loan"
    
78.             returnedVal = "输入贷款信息"
    
79.         Case "Annuity"
    
80.             returnedVal = "输入年金信息"
    
81.         Case "EffectiveRate"
    
82.             returnedVal = "输入有效利率信息"
    
83.         Case Else
    
84.             returnedVal = "没有实现!"
    
85.     End Select
    
86. End Sub
    
87. 
    
88. Sub AmountLabel(control As IRibbonControl, ByRef returnedVal)
    
89.     ' 通过计算类型的选择决定数量标签
    
90.     ' 由于有效利率计算不使用该控件,因此应用程序不给它提供标签
    
91.     Select Case CalcType
    
92.         Case "Loan"
    
93.             returnedVal = "贷款金额"
    
94.         Case "Annuity"
    
95.             returnedVal = "每月年金付款"
    
96.         Case Else
    
97.             returnedVal = "没有实现!"
    
98.     End Select
    
99. End Sub
    
100. 
     
101. Sub TermCount(control As IRibbonControl, ByRef returnedVal)
     
102.     If CalcType = "Loan" Then
     
103.         returnedVal = 4
     
104.     Else
     
105.         returnedVal = 5
     
106.     End If
     
107. End Sub
     
108. 
     
109. Sub TermItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)
     
110.     If CalcType = "Loan" Then
     
111.         returnedVal = Array("10年", "15年", "20年", "30年")(index)
     
112.     Else
     
113.         returnedVal = Array("5年", "7年", "10年", "15年", "20年")(index)
     
114.     End If
     
115. End Sub
     
116. 
     
117. Sub TermItemID(control As IRibbonControl, index As Integer, ByRef id)
     
118.     id = "rxitem" & index
     
119. End Sub
     
120. 
     
121. Sub GetRateText(control As IRibbonControl, ByVal text As String)
     
122.     ' 保存文本的输入值
     
123.     Rate = Val(text)
     
124. End Sub
     
125. 
     
126. Sub GetSelectedTerm(control As IRibbonControl, ByVal selectedId As String, ByVal selectedIndex As Integer)
     
127.     ' 存储默认值
     
128.     Term = 0
     
129. 
     
130.     ' 保存贷款项
     
131.     If CalcType = "Loan" Then
     
132.         Select Case selectedIndex
     
133.             Case 0
     
134.                 Term = 10
     
135.             Case 1
     
136.                 Term = 15
     
137.             Case 2
     
138.                 Term = 20
     
139.             Case 3
     
140.                 Term = 30
     
141.         End Select
     
142.     End If
     
143. 
     
144.     ' 保存年金项
     
145.     If CalcType = "Annuity" Then
     
146.         Select Case selectedIndex
     
147.             Case 0
     
148.                 Term = 5
     
149.             Case 1
     
150.                 Term = 7
     
151.             Case 2
     
152.                 Term = 10
     
153.             Case 3
     
154.                 Term = 15
     
155.             Case 4
     
156.                 Term = 20
     
157.         End Select
     
158.     End If
     
159. End Sub
     
160. 
     
161. Sub GetPaymentText(control As IRibbonControl, ByVal text As String)
     
162.     ' 保存文本的输入值
     
163.     Payment = Val(text)
     
164. End Sub
     
165. 
     
166. Sub GetAmountText(control As IRibbonControl, ByVal text As String)
     
167.     ' 保存文本的输入值
     
168.     Amount = Val(text)
     
169. End Sub
     
170. 
     
171. Sub Calculate(control As IRibbonControl)
     
172.     Select Case CalcType
     
173.         Case "Loan"
     
174.             ActiveCell = "=PMT(" & Rate / 100 / 12 & "," & Term * 12 & "," & Amount & ",0,0)"
     
175.         Case "Annuity"
     
176.             ActiveCell = "=FV(" & Rate / 100 / 12 & "," & Term * 12 & "," & Payment & "," & Amount & ",0)"
     
177.         Case "EffectiveRate"
     
178.             ActiveCell = "=EFFECT(" & Rate / 100 / 12 & ",12)"
     
179.     End Select
     
180.     Application.Calculation = xlCalculationAutomatic
     
181. End Sub
     

复制代码

VBA万岁

VBA万岁 发表于 2015-10-29 16:08
终于解决了，代码如下：
VBA（Module1）代码：

VBA（Module2）代码：

1. Sub DisplayRedundantCalc(ByVal control As Office.IRibbonControl)
   
2.     ' 选择正确的过程.
   
3.     Select Case CalcType
   
4.         Case "Loan"
   
5.             PerformLoanRangeCalc
   
6.         Case "Annuity"
   
7.             PerformAnnuityRangeCalc
   
8.         Case "EffectiveRate"
   
9.             PerformEffectiveRateRangeCalc
   
10.     End Select
    
11. End Sub
    
12. 
    
13. Sub PerformLoanRangeCalc()
    
14.     msg = InputBox("利率开始值/利率最终值/利率增加量/期数开始值/期数率最终值/初始金额：", "请输入批量信息：", "1/12/1/" & IIf(CalcType = "Loan", 10, 5) & "/" & IIf(CalcType = "Loan", 30, 20) & "/105000")
    
15.     Rate = Val(Split(msg, "/")(0))
    
16.     Term = Val(Split(msg, "/")(3))
    
17.     Amount = Val(Split(msg, "/")(5))
    
18. 
    
19.     ' 创建本地变量,包括计算数据.
    
20.     EndRate = Val(Split(msg, "/")(1))
    
21.     IncRate = Val(Split(msg, "/")(2))
    
22.     EndTerm = Val(Split(msg, "/")(4))
    
23. 
    
24.     ' 添加初始标题.
    
25.     Application.Selection.Cells(1, 1) = "利息"
    
26. 
    
27.     ' 执行计算.
    
28.     Dim i As Integer
    
29.     For i = Rate To EndRate
    
30.         ' 计算X和Y的位置值.
    
31.         X = i + 2 - Rate
    
32.         Y = 2
    
33.         Application.Selection.Cells(X, 1) = Format(i / 100, "#%")
    
34.         ' 使用一系列if语句确定年设置.
    
35.         If Term = 10 And EndTerm >= 10 Then
    
36.             ' 执行计算.
    
37.             Application.Selection.Cells(X, Y) = "=PMT(" & i / 100 / 12 & "," & 10 * 12 & "," & Amount & ",0,0)"
    
38.             ' 打印标题.
    
39.             Application.Selection.Cells(1, Y) = "10年"
    
40.              ' 如果已经使用则增加Y.
    
41.             Y = Y + 1
    
42.         End If
    
43. 
    
44.         If Term <= 15 And EndTerm >= 15 Then
    
45.             ' 执行计算.
    
46.             Application.Selection.Cells(X, Y) = "=PMT(" & i / 100 / 12 & "," & 15 * 12 & "," & Amount & ",0,0)"
    
47.             ' 打印标题.
    
48.             Application.Selection.Cells(1, Y) = "15年"
    
49.             ' 如果已经使用则增加Y.
    
50.             Y = Y + 1
    
51.         End If
    
52. 
    
53.         If Term <= 20 And EndTerm >= 20 Then
    
54.             ' 执行计算.
    
55.             Application.Selection.Cells(X, Y) = "=PMT(" & i / 100 / 12 & "," & 20 * 12 & "," & Amount & ",0,0)"
    
56.             ' 打印标题.
    
57.             Application.Selection.Cells(1, Y) = "20年"
    
58.             ' 如果已经使用则增加Y.
    
59.             Y = Y + 1
    
60.         End If
    
61. 
    
62.         If Term <= 30 And EndTerm >= 30 Then
    
63.             ' 执行计算.
    
64.             Application.Selection.Cells(X, Y) = "=PMT(" & i / 100 / 12 & "," & 30 * 12 & "," & Amount & ",0,0)"
    
65.             ' 打印标题.
    
66.             Application.Selection.Cells(1, Y) = "30年"
    
67.             ' 如果已经使用则增加Y.
    
68.             Y = Y + 1
    
69.         End If
    
70.     Next
    
71. End Sub
    
72. 
    
73. Sub PerformAnnuityRangeCalc()
    
74.     msg = InputBox("利率开始值/利率最终值/利率增加量/期数开始值/期数率最终值/初始金额/支付金额：", "请输入批量信息：", "1/12/1/" & IIf(CalcType = "Loan", 10, 5) & "/" & IIf(CalcType = "Loan", 30, 20) & "/500/500")
    
75.     Rate = Val(Split(msg, "/")(0))
    
76.     Term = Val(Split(msg, "/")(3))
    
77.     Amount = Val(Split(msg, "/")(5))
    
78.     Payment = Val(Split(msg, "/")(6))
    
79. 
    
80.     ' 创建本地变量,包括计算数据.
    
81.     EndRate = Val(Split(msg, "/")(1))
    
82.     IncRate = Val(Split(msg, "/")(2))
    
83.     EndTerm = Val(Split(msg, "/")(4))
    
84. 
    
85.     ' 添加初始标题.
    
86.     Application.Selection.Cells(1, 1) = "利息"
    
87.    
    
88.     ' 执行计算.
    
89.     Dim i As Integer
    
90.     For i = Rate To EndRate
    
91.         ' 计算X和Y的位置值.
    
92.         X = i + 2 - Rate
    
93.         Y = 2
    
94.         Application.Selection.Cells(X, 1) = Format(i / 100, "#%")
    
95. 
    
96.         If Term = 5 And EndTerm >= 5 Then
    
97.             ' 执行计算.
    
98.             Application.Selection.Cells(X, Y) = "=FV(" & i / 100 / 12 & "," & 5 * 12 & "," & Payment & "," & Amount & ",0)"
    
99.             ' 打印标题.
    
100.             Application.Selection.Cells(1, Y) = "5年"
     
101.              ' 如果已经使用则增加Y.
     
102.             Y = Y + 1
     
103.         End If
     
104. 
     
105.         If Term <= 7 And EndTerm >= 7 Then
     
106.             ' 执行计算.
     
107.             Application.Selection.Cells(X, Y) = "=FV(" & i / 100 / 12 & "," & 7 * 12 & "," & Payment & "," & Amount & ",0)"
     
108.             ' 打印标题.
     
109.             Application.Selection.Cells(1, Y) = "7年"
     
110.              ' 如果已经使用则增加Y.
     
111.             Y = Y + 1
     
112.         End If
     
113. 
     
114.         If Term <= 10 And EndTerm >= 10 Then
     
115.             ' 执行计算.
     
116.             Application.Selection.Cells(X, Y) = "=FV(" & i / 100 / 12 & "," & 10 * 12 & "," & Payment & "," & Amount & ",0)"
     
117.             ' 打印标题.
     
118.             Application.Selection.Cells(1, Y) = "10年"
     
119.              ' 如果已经使用则增加Y.
     
120.             Y = Y + 1
     
121.         End If
     
122. 
     
123.         If Term <= 15 And EndTerm >= 15 Then
     
124.             ' 执行计算.
     
125.             Application.Selection.Cells(X, Y) = "=FV(" & i / 100 / 12 & "," & 15 * 12 & "," & Payment & "," & Amount & ",0)"
     
126.             ' 打印标题.
     
127.             Application.Selection.Cells(1, Y) = "15年"
     
128.              ' 如果已经使用则增加Y.
     
129.             Y = Y + 1
     
130.         End If
     
131. 
     
132.         If Term <= 20 And EndTerm >= 20 Then
     
133.             ' 执行计算.
     
134.             Application.Selection.Cells(X, Y) = "=FV(" & i / 100 / 12 & "," & 20 * 12 & "," & Payment & "," & Amount & ",0)"
     
135.             ' 打印标题.
     
136.             Application.Selection.Cells(1, Y) = "20年"
     
137.              ' 如果已经使用则增加Y.
     
138.             Y = Y + 1
     
139.         End If
     
140.     Next
     
141. End Sub
     
142. 
     
143. Sub PerformEffectiveRateRangeCalc()
     
144.     msg = InputBox("利率开始值/利率最终值/利率增加量：", "请输入批量信息：", "1/12/1")
     
145.     Rate = Val(Split(msg, "/")(0))
     
146. 
     
147.     ' 创建本地变量,包括计算数据.
     
148.     EndRate = Val(Split(msg, "/")(1))
     
149.     IncRate = Val(Split(msg, "/")(2))
     
150. 
     
151.     ' 添加初始标题.
     
152.     Application.Selection.Cells(1, 1) = "利息"
     
153.     Application.Selection.Cells(1, 2) = "有效利率"
     
154. 
     
155.     ' 执行计算.
     
156.     Dim i As Integer
     
157.     For i = Rate To EndRate
     
158.         ' 计算X和Y的位置值.
     
159.         X = i + 2 - Rate
     
160.         Application.Selection.Cells(X, 1) = Format(i / 100, "#%")
     
161.         ' 执行计算.
     
162.         Application.Selection.Cells(X, 2) = "=EFFECT(" & i / 100 / 12 & ",12)"
     
163.         'Globals.ThisAddIn.CalculateEFFECT(i, X, 2)
     
164.     Next
     
165. End Sub
     

复制代码

VBA万岁

VBA万岁 发表于 2015-10-29 16:09
VBA（Module2）代码：

XML代码：

1. <customUI onLoad="RibLoad" xmlns="http://schemas.microsoft.com/office/2006/01/customui">
   
2.   <ribbon>
   
3.     <tabs>
   
4.       <tab id="myTab" label="专用等式" keytip="MT">
   
5.         <group id="Default" label="开始">
   
6.            <labelControl id="StartLabel1" label="选择一个"/>
   
7.            <labelControl id="StartLabel2" label="开始点"/>
   
8.            <labelControl id="StartLabel3" label="用于计算."/>
   
9.         </group>
   
10.             
    
11.                
    
12.         <group id="Equations" label="等式">
    
13.            <toggleButton id="Loan"
    
14.                label="贷款"
    
15.                onAction="GetControlID"
    
16.                getPressed="SelectedEquation"/>
    
17.            <toggleButton id="Annuity"
    
18.                label="年金"
    
19.                onAction="GetControlID"
    
20.                getPressed="SelectedEquation"/>
    
21.            <toggleButton id="EffectiveRate"
    
22.                label="有效利率"
    
23.                onAction="GetControlID"
    
24.                getPressed="SelectedEquation"/>
    
25.          </group>
    
26. 
    
27.          <group id="DataEntry" getLabel="GetDataEntryLabel">
    
28.             <editBox id="Rate"
    
29.                label="利率"
    
30.                onChange="GetRateText"/>
    
31.             <dropDown id="Term"
    
32.                label="期数"
    
33.                getVisible="TermVisible"
    
34.                getItemCount="TermCount"
    
35.                getItemID="TermItemID"
    
36.                getItemLabel="TermItemLabel"
    
37.                onAction="GetSelectedTerm"/>
    
38.             <editBox id="Payment"
    
39.                label="期初付款"
    
40.                getVisible="PaymentVisible"
    
41.                onChange="GetPaymentText"/>
    
42.             <editBox id="Amount"
    
43.                getLabel="AmountLabel"
    
44.                getVisible="AmountVisible"
    
45.                onChange="GetAmountText"/>
    
46.             <dialogBoxLauncher>
    
47.                <button id="RedundantCalcsLaunch"
    
48.                screentip="多重计算"
    
49.                supertip="多次执行同一公式的计算."
    
50.                onAction="DisplayRedundantCalc"/>
    
51.             </dialogBoxLauncher>
    
52.          </group>
    
53. 
    
54. 
    
55.          <group id="Finishcalculate" label="完成">
    
56.             <button id="Startcac"
    
57.                label="开始计算"
    
58.                imageMso="CalculationOptionsMenu"
    
59.                size="large"
    
60.                onAction="Calculate"/>
    
61.          </group>
    
62.       </tab>
    
63.     </tabs>
    
64.   </ribbon>
    
65. </customUI>
    

复制代码

VBA万岁

VBA万岁 发表于 2015-10-29 16:10
XML代码：

附件如下：

VBA万岁

VBA万岁 发表于 2015-10-29 16:11
附件如下：

窗体版附件如下：

gjj136138139

加载不了，打不开，是不是版本的问题？我用的是VS2010