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

VBA万岁

学了如下帖子：
细品RibbonX(55)：在Visual Studio中开发Excel商务应用程序-第8页
尝试着用VSTO2010的vb语言，制作附件如下：

VBA万岁

功能区EditBox下拉选项的设置方法如下：

VBA万岁

VBA万岁 发表于 2015-10-24 17:18
功能区EditBox下拉选项的设置方法如下：

设计对话框（LoanRangeSelection/选择货款范围， AnnuityRangeSelection/选择年金范围， EffectiveRateRangeSelection/选择有效利率范围）的方法如下：

VBA万岁

VBA万岁 发表于 2015-10-24 17:19
设计对话框（LoanRangeSelection/选择货款范围， AnnuityRangeSelection/选择年金范围， EffectiveRateRa ...

效果截图：

VBA万岁

VBA万岁 发表于 2015-10-24 17:21
效果截图：

代码：
ThisAddIn：

1. Public Class ThisAddIn
   
2. 
   
3.     Private Sub ThisAddIn_Startup() Handles Me.Startup
   
4. 
   
5.     End Sub
   
6. 
   
7.     Private Sub ThisAddIn_Shutdown() Handles Me.Shutdown
   
8. 
   
9.     End Sub
   
10. 
    
11.     ' 计算贷款数量
    
12.     Public Sub CalculatePMT(ByVal Rate As Double, ByVal NPer As Int32, ByVal PV As Int32)
    
13.         ' 计算利率
    
14.         Dim PeriodicRate As Double = (Rate / 100) / 12
    
15.         ' 计算期数
    
16.         Dim Periods As Int32 = NPer * 12
    
17.         ' 执行计算
    
18.         Application.ActiveWindow.ActiveCell.Cells(1, 1) = "=PMT(" + PeriodicRate.ToString() + "," + Periods.ToString() + "," + PV.ToString() + ",0,0)"
    
19.         Application.ActiveWindow.ActiveCell.Calculate()
    
20.     End Sub
    
21. 
    
22.     ' 计算年金数量
    
23.     Public Sub CalculateFV(ByVal Rate As Double, ByVal NPer As Int32, ByVal PMT As Int32, ByVal PV As Int32)
    
24.         ' 计算利率
    
25.         Dim PeriodicRate As Double = (Rate / 100) / 12
    
26.         ' 计算期数
    
27.         Dim Periods As Int32 = NPer * 12
    
28.         ' 执行计算
    
29.         Application.ActiveWindow.ActiveCell.Cells(1, 1) = "=FV(" + PeriodicRate.ToString() + "," + Periods.ToString() + "," + PMT.ToString() + "," + PV.ToString() + ",0)"
    
30.         Application.ActiveWindow.ActiveCell.Calculate()
    
31.     End Sub
    
32. 
    
33.     ' 计算有效利率
    
34.     Public Sub CalculateEFFECT(ByVal Rate As Double)
    
35.         ' 计算利率
    
36.         Dim PeriodicRate As Double = Rate / 100
    
37.         ' 执行计算
    
38.         Application.ActiveWindow.ActiveCell.Cells(1, 1) = "=EFFECT(" + PeriodicRate.ToString() + ",12)"
    
39.         Application.ActiveWindow.ActiveCell.Calculate()
    
40.     End Sub
    
41. 
    
42.     ' 计算贷款金额并包括位置数据
    
43.     Public Sub CalculatePMTT(ByVal Rate As Double, ByVal NPer As Int32, ByVal PV As Int32, ByVal X As Int32, ByVal Y As Int32)
    
44.         ' 计算利率.
    
45.         Dim PeriodicRate As Double = (Rate / 100) / 12
    
46.         ' 计算期数.
    
47.         Dim Periods As Int32 = NPer * 12
    
48.         ' 执行计算.
    
49.         Application.ActiveWindow.ActiveCell.Cells(X, Y) = "=PMT(" + PeriodicRate.ToString() + "," + Periods.ToString() + "," + PV.ToString() + ",0,0)"
    
50.         Application.ActiveWindow.ActiveCell.Calculate()
    
51.     End Sub
    
52. 
    
53.     ' 计算年金金额并包括位置数据.
    
54.     Public Sub CalculateFVV(ByVal Rate As Double, ByVal NPer As Int32, ByVal PMT As Int32, ByVal PV As Int32, ByVal X As Int32, ByVal Y As Int32)
    
55.         ' 计算利率.
    
56.         Dim PeriodicRate As Double = (Rate / 100) / 12
    
57.         ' 计算期数.
    
58.         Dim Periods As Int32 = NPer * 12
    
59.         ' 执行计算.
    
60.         Application.ActiveWindow.ActiveCell.Cells(X, Y) = "=FV(" + PeriodicRate.ToString() + "," + Periods.ToString() + "," + PMT.ToString() + "," + PV.ToString() + ",0)"
    
61.         Application.ActiveWindow.ActiveCell.Calculate()
    
62.     End Sub
    
63. 
    
64.     ' 计算有效利率并包括数据位置.
    
65.     Public Sub CalculateEFFECTT(ByVal Rate As Double, ByVal X As Int32, ByVal Y As Int32)
    
66.         ' 计算利率.
    
67.         Dim PeriodicRate As Double = (Rate / 100) / 12
    
68.         ' 执行计算.
    
69.         Application.ActiveWindow.ActiveCell.Cells(X, Y) = "=EFFECT(" + PeriodicRate.ToString() + ",12)"
    
70.         Application.ActiveWindow.ActiveCell.Calculate()
    
71.         ' 格式单元格.
    
72.         Dim ThisRange As Excel.Range
    
73.         ThisRange = Application.Cells(X, Y)
    
74.         ThisRange.NumberFormat = "0.0000%"
    
75.     End Sub
    
76. 
    
77.     Public Sub SetHeading(ByVal Heading As String, ByVal X As Int32, ByVal Y As Int32)
    
78.         ' 添加所需要的标题.
    
79.         Application.ActiveWindow.ActiveCell.Cells(X, Y) = Heading
    
80.     End Sub
    
81. End Class

复制代码

VBA万岁

VBA万岁 发表于 2015-10-24 17:22
代码：
ThisAddIn：

Module1：

1. Module Module1
   
2.     Public CalcType
   
3.     Public R
   
4.     Public T
   
5.     Public A
   
6.     Public P
   
7. End Module
   

复制代码

VBA万岁

VBA万岁 发表于 2015-10-24 17:23
Module1：

Ribbon1.vb：

1. Imports Microsoft.Office.Tools.Ribbon
   
2. 
   
3. Public Class Ribbon2
   
4. 
   
5.     Private Sub Ribbon2_Load(ByVal sender As System.Object, ByVal e As RibbonUIEventArgs) Handles MyBase.Load
   
6. 
   
7.     End Sub
   
8. 
   
9.     Private Sub Loan_Click(sender As System.Object, e As Microsoft.Office.Tools.Ribbon.RibbonControlEventArgs) Handles Loan.Click
   
10.         Loan.Checked = True
    
11.         Annuity.Checked = False
    
12.         EffectiveRate.Checked = False
    
13.         DataEntry.Label = "输入贷款信息"
    
14.         Term.Visible = True
    
15.         Payment.Visible = False
    
16.         Amount.Visible = True
    
17.         Amount.Label = "贷款金额"
    
18.         CalcType = "Loan"
    
19.     End Sub
    
20. 
    
21.     Private Sub Annuity_Click(sender As System.Object, e As Microsoft.Office.Tools.Ribbon.RibbonControlEventArgs) Handles Annuity.Click
    
22.         Loan.Checked = False
    
23.         Annuity.Checked = True
    
24.         EffectiveRate.Checked = False
    
25.         DataEntry.Label = "输入年金信息"
    
26.         Term.Visible = True
    
27.         Payment.Visible = True
    
28.         Amount.Visible = True
    
29.         Amount.Label = "每月年金付款"
    
30.         CalcType = "Annuity"
    
31.     End Sub
    
32. 
    
33.     Private Sub EffectiveRate_Click(sender As System.Object, e As Microsoft.Office.Tools.Ribbon.RibbonControlEventArgs) Handles EffectiveRate.Click
    
34.         Loan.Checked = False
    
35.         Annuity.Checked = False
    
36.         EffectiveRate.Checked = True
    
37.         DataEntry.Label = "输入有效利率信息"
    
38.         Term.Visible = False
    
39.         Payment.Visible = False
    
40.         Amount.Visible = False
    
41.         CalcType = "EffectiveRate"
    
42.     End Sub
    
43. 
    
44.     Private Sub Button1_Click(sender As System.Object, e As Microsoft.Office.Tools.Ribbon.RibbonControlEventArgs) Handles Button1.Click
    
45.         ' 选择计算并调用
    
46.         Select Case CalcType
    
47.             Case "Loan"
    
48.                 Globals.ThisAddIn.CalculatePMT(Rate.Text, Replace(Term.SelectedItem.Label, "年", ""), Amount.Text)
    
49.             Case "Annuity"
    
50.                 Globals.ThisAddIn.CalculateFV(Rate.Text, Replace(Term.SelectedItem.Label, "年", ""), Payment.Text, Amount.Text)
    
51.             Case "Effective Rate"
    
52.                 Globals.ThisAddIn.CalculateEFFECT(Rate.Text)
    
53.         End Select
    
54.     End Sub
    
55. 
    
56.     Private Sub RedundantCalcsLaunch_Click(sender As System.Object, e As Microsoft.Office.Tools.Ribbon.RibbonControlEventArgs) Handles RedundantCalcsLaunch.Click
    
57.         ' 选择正确的过程.
    
58.         Select Case CalcType
    
59.             Case "Loan"
    
60.                 PerformLoanRangeCalc()
    
61.             Case "Annuity"
    
62.                 PerformAnnuityRangeCalc()
    
63.             Case "EffectiveRate"
    
64.                 PerformEffectiveRateRangeCalc()
    
65.         End Select
    
66.     End Sub
    
67. 
    
68.     Private Sub PerformLoanRangeCalc()
    
69.         ' 创建对话框.
    
70.         Dim ThisSelection As LoanRangeSelection = New LoanRangeSelection()
    
71. 
    
72.         ' 在对话框中添加已存在的变量.
    
73.         ThisSelection.txtIntBeg.Text = Rate.Text
    
74.         ThisSelection.txtIntEnd.Text = Rate.Text
    
75.         ThisSelection.txtIntInc.Text = "1"
    
76.         ThisSelection.cbTermBeg.Text = Replace(Term.SelectedItem.Label, "年", "")
    
77.         ThisSelection.cbTermEnd.Text = Replace(Term.SelectedItem.Label, "年", "")
    
78.         ThisSelection.txtLoanAmt.Text = Amount.Text
    
79. 
    
80.         ' 显示对话框并且如果用户单击确定则处理数据.
    
81.         If ThisSelection.ShowDialog() = Windows.Forms.DialogResult.OK Then
    
82.             ' 转换数据值为Int32egers.
    
83.             R = Int32.Parse(ThisSelection.txtIntBeg.Text)
    
84.             T = Int32.Parse(ThisSelection.cbTermBeg.Text)
    
85.             A = Int32.Parse(ThisSelection.txtLoanAmt.Text)
    
86. 
    
87.             ' 创建本地变量,包括计算数据.
    
88.             Dim EndRate As Int32 = Int32.Parse(ThisSelection.txtIntEnd.Text)
    
89.             Dim IncRate As Int32 = Int32.Parse(ThisSelection.txtIntInc.Text)
    
90.             Dim EndTerm As Int32 = Int32.Parse(ThisSelection.cbTermEnd.Text)
    
91. 
    
92.             ' 更新功能区中的值.
    
93.             'ribbon.InvalidateControl("Rate")
    
94.             'ribbon.InvalidateControl("Term")
    
95.             'ribbon.InvalidateControl("Amount")
    
96. 
    
97.             ' 添加初始标题.
    
98.             Globals.ThisAddIn.SetHeading("利息", 1, 1)
    
99. 
    
100.             ' 执行计算.
     
101.             Dim i As Int32
     
102.             For i = R To EndRate
     
103. 
     
104.                 ' 计算X和Y的位置值.
     
105.                 Dim X As Int32 = i + 2 - R
     
106.                 Dim Y As Int32 = 2
     
107. 
     
108.                 ' 打印Int32erest利率.
     
109.                 Globals.ThisAddIn.SetHeading(i.ToString() + "%", X, 1)
     
110. 
     
111.                 ' 使用一系列if语句确定年设置.
     
112.                 If T = 10 And EndTerm >= 10 Then
     
113.                     ' 执行计算.
     
114.                     Globals.ThisAddIn.CalculatePMTT(i, 10, A, X, Y)
     
115. 
     
116.                     ' 打印标题.
     
117.                     Globals.ThisAddIn.SetHeading("10年", 1, Y)
     
118. 
     
119.                     ' 如果已经使用则增加Y.
     
120.                     Y = Y + 1
     
121.                 End If
     
122. 
     
123.                 If T <= 15 And EndTerm >= 15 Then
     
124.                     ' 执行计算.
     
125.                     Globals.ThisAddIn.CalculatePMTT(i, 15, A, X, Y)
     
126. 
     
127.                     ' 打印标题.
     
128.                     Globals.ThisAddIn.SetHeading("15年", 1, Y)
     
129. 
     
130.                     ' 如果已经使用则增加Y.
     
131.                     Y = Y + 1
     
132.                 End If
     
133. 
     
134.                 If T <= 20 And EndTerm >= 20 Then
     
135.                     ' 执行计算.
     
136.                     Globals.ThisAddIn.CalculatePMTT(i, 20, A, X, Y)
     
137. 
     
138.                     ' 打印标题.
     
139.                     Globals.ThisAddIn.SetHeading("20年", 1, Y)
     
140. 
     
141.                     ' 如果已经使用则增加Y.
     
142.                     Y = Y + 1
     
143.                 End If
     
144. 
     
145.                 If T <= 30 And EndTerm >= 30 Then
     
146.                     ' 执行计算.
     
147.                     Globals.ThisAddIn.CalculatePMTT(i, 30, A, X, Y)
     
148. 
     
149.                     ' 打印标题.
     
150.                     Globals.ThisAddIn.SetHeading("30年", 1, Y)
     
151. 
     
152.                     ' 如果已经使用则增加Y.
     
153.                     Y = Y + 1
     
154.                 End If
     
155.             Next
     
156.         End If
     
157.     End Sub
     
158. 
     
159.     Private Sub PerformAnnuityRangeCalc()
     
160.         ' 创建对话框.
     
161.         Dim ThisSelection As AnnuityRangeSelection = New AnnuityRangeSelection()
     
162. 
     
163.         ' 在对话框中添加已存在的变量.
     
164.         ThisSelection.txtIntBeg.Text = Rate.Text
     
165.         ThisSelection.txtIntEnd.Text = Rate.Text
     
166.         ThisSelection.txtIntInc.Text = "1"
     
167.         ThisSelection.cbTermBeg.Text = Replace(Term.SelectedItem.Label, "年", "")
     
168.         ThisSelection.cbTermEnd.Text = Replace(Term.SelectedItem.Label, "年", "")
     
169.         ThisSelection.txtLoanAmt.Text = Amount.Text
     
170.         ThisSelection.txtPayment.Text = Payment.Text
     
171. 
     
172.         ' 显示对话框并且如果用户单击确定则处理数据.
     
173.         If ThisSelection.ShowDialog() = Windows.Forms.DialogResult.OK Then
     
174. 
     
175.             ' 转换数据值为Int32egers.
     
176.             R = Int32.Parse(ThisSelection.txtIntBeg.Text)
     
177.             T = Int32.Parse(ThisSelection.cbTermBeg.Text)
     
178.             A = Int32.Parse(ThisSelection.txtLoanAmt.Text)
     
179.             P = Int32.Parse(ThisSelection.txtPayment.Text)
     
180. 
     
181.             ' 创建本地变量以包含计算数据.
     
182.             Dim EndRate As Int32 = Int32.Parse(ThisSelection.txtIntEnd.Text)
     
183.             Dim IncRate As Int32 = Int32.Parse(ThisSelection.txtIntInc.Text)
     
184.             Dim EndTerm As Int32 = Int32.Parse(ThisSelection.cbTermEnd.Text)
     
185. 
     
186.             ' 更新功能区中的值.
     
187.             'ribbon.InvalidateControl("Rate")
     
188.             'ribbon.InvalidateControl("Term")
     
189.             'ribbon.InvalidateControl("Amount")
     
190.             'ribbon.InvalidateControl("Payment")
     
191. 
     
192.             ' 添加初始标题.
     
193.             Globals.ThisAddIn.SetHeading("利息", 1, 1)
     
194. 
     
195.             ' 执行计算.
     
196.             Dim i As Int32
     
197.             For i = R To EndRate
     
198. 
     
199.                 ' 计算X和Y的位置值.
     
200.                 Dim X As Int32 = i + 2 - R
     
201.                 Dim Y As Int32 = 2
     
202. 
     
203.                 ' 打印Int32erest利率.
     
204.                 Globals.ThisAddIn.SetHeading(i.ToString() + "%", X, 1)
     
205. 
     
206.                 ' 使用一系列if语句决定年设置.
     
207.                 If T = 5 And EndTerm >= 5 Then
     
208.                     ' 执行计算.
     
209.                     Globals.ThisAddIn.CalculateFVV(i, 5, A, P, X, Y)
     
210. 
     
211.                     ' 打印标题.
     
212.                     Globals.ThisAddIn.SetHeading("5年", 1, Y)
     
213. 
     
214.                     ' 如果已经使用则增加Y.
     
215.                     Y = Y + 1
     
216.                 End If
     
217. 
     
218.                 If T <= 7 And EndTerm >= 7 Then
     
219.                     ' 执行计算.
     
220.                     Globals.ThisAddIn.CalculateFVV(i, 7, A, P, X, Y)
     
221. 
     
222.                     ' 打印标题.
     
223.                     Globals.ThisAddIn.SetHeading("7年", 1, Y)
     
224. 
     
225.                     ' 如果已经使用则增加Y.
     
226.                     Y = Y + 1
     
227.                 End If
     
228. 
     
229.                 If T <= 10 And EndTerm >= 10 Then
     
230.                     ' 执行计算.
     
231.                     Globals.ThisAddIn.CalculateFVV(i, 10, A, P, X, Y)
     
232. 
     
233.                     ' 打印标题.
     
234.                     Globals.ThisAddIn.SetHeading("10年", 1, Y)
     
235. 
     
236.                     ' 如果已经使用则增加Y.
     
237.                     Y = Y + 1
     
238.                 End If
     
239. 
     
240.                 If T <= 15 And EndTerm >= 15 Then
     
241.                     ' 执行计算.
     
242.                     Globals.ThisAddIn.CalculateFVV(i, 15, A, P, X, Y)
     
243. 
     
244.                     ' 打印标题.
     
245.                     Globals.ThisAddIn.SetHeading("15年", 1, Y)
     
246. 
     
247.                     ' 如果已经使用则增加Y.
     
248.                     Y = Y + 1
     
249.                 End If
     
250. 
     
251.                 If T <= 20 And EndTerm >= 20 Then
     
252.                     ' 执行计算.
     
253.                     Globals.ThisAddIn.CalculateFVV(i, 20, A, P, X, Y)
     
254. 
     
255.                     ' 打印标题.
     
256.                     Globals.ThisAddIn.SetHeading("20年", 1, Y)
     
257. 
     
258.                     ' 如果已经使用则增加Y.
     
259.                     Y = Y + 1
     
260.                 End If
     
261.             Next
     
262.         End If
     
263.     End Sub
     
264. 
     
265.    

复制代码

VBA万岁

VBA万岁 发表于 2015-10-26 08:49
Ribbon1.vb：

续上（7楼的代码因起过1000字而被限制发送）：

1. Private Sub PerformEffectiveRateRangeCalc()
   
2.         ' 创建对话框.
   
3.         Dim ThisSelection As EffectiveRateRangeSelection = New EffectiveRateRangeSelection()
   
4. 
   
5.         ' 在对话框中添加已存在的变量.
   
6.         ThisSelection.txtIntBeg.Text = Rate.Text
   
7.         ThisSelection.txtIntEnd.Text = Rate.Text
   
8.         ThisSelection.txtIntInc.Text = "1"
   
9. 
   
10.         ' 显示对话框并且如果用户单击确定则处理数据.
    
11.         If ThisSelection.ShowDialog() = Windows.Forms.DialogResult.OK Then
    
12. 
    
13.             ' 转换数据值为Int32egers.
    
14.             R = Int32.Parse(ThisSelection.txtIntBeg.Text)
    
15. 
    
16.             ' 创建本地变量以包含计算数据.
    
17.             Dim EndRate As Int32 = Int32.Parse(ThisSelection.txtIntEnd.Text)
    
18.             Dim IncRate As Int32 = Int32.Parse(ThisSelection.txtIntInc.Text)
    
19. 
    
20.             ' 更新功能区中的值.
    
21.             'ribbon.InvalidateControl("Rate")
    
22. 
    
23.             ' 添加初始标题.
    
24.             Globals.ThisAddIn.SetHeading("利息", 1, 1)
    
25.             Globals.ThisAddIn.SetHeading("有效利率", 1, 2)
    
26. 
    
27.             ' 执行计算.
    
28.             Dim i As Int32
    
29.             For i = R To EndRate
    
30.                 ' 计算X和Y位置值.
    
31.                 Dim X As Int32 = i + 2 - R
    
32. 
    
33.                 ' 打印Int32erest利率.
    
34.                 Globals.ThisAddIn.SetHeading(i.ToString() + "%", X, 1)
    
35. 
    
36.                 ' 执行计算.
    
37.                 Globals.ThisAddIn.CalculateEFFECTT(i, X, 2)
    
38.             Next
    
39.         End If
    
40.     End Sub
    
41. End Class

复制代码

VBA万岁

VBA万岁 发表于 2015-10-26 08:52
续上（7楼的代码因起过1000字而被限制发送）：

我曾经试着用VBA+XML制作，却以失败告终。但愿我的热情能消融本版的坚冰，引来众高人的关注和帮助。代码如下：
XML代码：

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

复制代码

VBA万岁

VBA万岁 发表于 2015-10-26 09:03
我曾经试着用VBA+XML制作，却以失败告终。但愿我的热情能消融本版的坚冰，引来众高人的关注和帮助。代码 ...

Module代码：

1.     Public CalcType
   
2.     Public Rate
   
3.     Public Term
   
4.     Public Payment
   
5.     Public Amount
   
6.    
   
7.     Sub SetupLoan(control As IRibbonControl, ByVal pressed As Boolean)
   
8.         ' 设置计算类型
   
9.         CalcType = "Loan"
   
10. 
    
11.         ' 设置按下状态
    
12.         pressed = True
    
13. 
    
14.         ' 使整个功能区无效
    
15.         ribbon.Invalidate
    
16.     End Sub
    
17. 
    
18.     Sub SetupAnnuity(control As IRibbonControl, ByVal pressed As Boolean)
    
19.         ' 设置计算类型
    
20.         CalcType = "Annuity"
    
21. 
    
22.         ' 设置按下状态
    
23.         pressed = True
    
24. 
    
25.         ' 使整个功能区无效
    
26.         ribbon.Invalidate
    
27.     End Sub
    
28. 
    
29.     Sub SetupEF(control As IRibbonControl, ByVal pressed As Boolean)
    
30.         ' 设置计算类型
    
31.         CalcType = "Effective Rate"
    
32. 
    
33.         ' 设置按下状态
    
34.         pressed = True
    
35. 
    
36.         ' 使整个功能区无效
    
37.         ribbon.Invalidate
    
38.     End Sub
    
39. 
    
40.     Function SelectedEquation(control As IRibbonControl) As Boolean
    
41.         ' 基于当前的等式确定按下状态
    
42.         Select Case CalcType
    
43.             Case "Loan"
    
44.                 If control.ID = "Loan" Then
    
45.                     SelectedEquation = True
    
46.                 Else
    
47.                     SelectedEquation = False
    
48.                 End If
    
49.             Case "Annuity"
    
50.                 If control.ID = "Annuity" Then
    
51.                     SelectedEquation = True
    
52.                 Else
    
53.                     SelectedEquation = False
    
54.                 End If
    
55.             Case "Effective Rate"
    
56.                 If control.ID = "EffectiveRate" Then
    
57.                     SelectedEquation = True
    
58.                 Else
    
59.                     SelectedEquation = False
    
60.                 End If
    
61.             Case Else
    
62.                 SelectedEquation = False
    
63.         End Select
    
64.     End Function
    
65. 
    
66.     Function TermVisible(control As IRibbonControl) As Boolean
    
67.         ' 应用程序不会使用该字段进行有效利率计算
    
68.         If CalcType = "Effective Rate" Then
    
69.             TermVisible = False
    
70.         Else
    
71.             TermVisible = True
    
72.         End If
    
73.     End Function
    
74. 
    
75.     Function PaymentVisible(control As IRibbonControl) As Boolean
    
76.         ' 当处理年金计算时应用程序仅使用该字段
    
77.         If CalcType = "Annuity" Then
    
78.             PaymentVisible = True
    
79.         Else
    
80.             PaymentVisible = False
    
81.         End If
    
82.     End Function
    
83. 
    
84.     Function AmountVisible(control As IRibbonControl) As Boolean
    
85.         ' 应用程序不会使用该字段进行有效利率计算
    
86.         If CalcType = "Effective Rate" Then
    
87.             AmountVisible = False
    
88.         Else
    
89.             AmountVisible = True
    
90.         End If
    
91.     End Function
    
92. 
    
93. 
    
94.     Function GetDataEntryLabel(control As IRibbonControl) As String
    
95.         ' 通过计算类型的选择决定组标签
    
96.         Select Case CalcType
    
97.             Case "Loan"
    
98.                 GetDataEntryLabel = "输入贷款信息"
    
99.             Case "Annuity"
    
100.                 GetDataEntryLabel = "输入年金信息"
     
101.             Case "Effective Rate"
     
102.                 GetDataEntryLabel = "输入有效利率信息"
     
103.             Case Else
     
104.                 GetDataEntryLabel = "没有实现!"
     
105.         End Select
     
106.     End Function
     
107. 
     
108.     Function AmountLabel(control As IRibbonControl) As String
     
109.         ' 通过计算类型的选择决定数量标签
     
110.         ' 由于有效利率计算不使用该控件,因此应用程序不给它提供标签
     
111.         Select Case CalcType
     
112.             Case "Loan"
     
113.                 AmountLabel = "贷款金额"
     
114.             Case "Annuity"
     
115.                 AmountLabel = "每月年金付款"
     
116.             Case Else
     
117.                 AmountLabel = "没有实现!"
     
118.         End Select
     
119.     End Function
     
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 Int32)
     
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 = Int32.Parse(text)
     
164.     End Sub
     
165. 
     
166.     Sub GetAmountText(control As IRibbonControl, ByVal text As String)
     
167.         ' 保存文本的输入值
     
168.         Amount = Int32.Parse(text)
     
169.     End Sub
     
170. 
     
171.     Sub Calculate(control As IRibbonControl)
     
172.         ' 选择计算并调用
     
173.         Select Case CalcType
     
174.             Case "Loan"
     
175.                 CalculatePMT(Rate,Term,Amount)
     
176.             Case "Annuity"
     
177.                 CalculateFV(Rate, Term, Payment, Amount)
     
178.             Case "Effective Rate"
     
179.                 CalculateEFFECT (Rate)
     
180.         End Select
     
181.     End Sub
     
182. 
     
183. 
     
184.     ' 计算贷款数量
     
185.     Sub CalculatePMT(ByVal Rate As Double, ByVal NPer As Integer, ByVal PV As Integer)
     
186.         ' 计算利率
     
187.         PeriodicRate = (Rate / 100) / 12
     
188. 
     
189.         ' 计算期数
     
190.         Periods = NPer * 12
     
191. 
     
192.         ' 执行计算
     
193.         ActiveCell = "=PMT(" & PeriodicRate & "," + Periods & "," + PV & ",0,0)"
     
194.     Application.Calculation = xlCalculationAutomatic
     
195.     'Application.Calculation = xlCalculationManual
     
196.         'Application.ActiveWindow.ActiveCell.Calculate()
     
197.     End Sub
     
198. 
     
199.     ' 计算年金数量
     
200.     Sub CalculateFV(ByVal Rate As Double, ByVal NPer As Integer, ByVal PMT As Integer, ByVal PV As Integer)
     
201.         ' 计算利率
     
202.         PeriodicRate = (Rate / 100) / 12
     
203. 
     
204.         ' 计算期数
     
205.         Periods = NPer * 12
     
206. 
     
207.         ' 执行计算
     
208.         ActiveCell = "=FV(" + PeriodicRate & "," + Periods & "," + PMT & "," + PV & ",0)"
     
209.     Application.Calculation = xlCalculationAutomatic
     
210.     'Application.Calculation = xlCalculationManual
     
211.         'Application.ActiveWindow.ActiveCell.Calculate()
     
212.     End Sub
     
213. 
     
214.     ' 计算有效利率
     
215.     Sub CalculateEFFECT(ByVal Rate As Double)
     
216.         ' 计算利率
     
217.         PeriodicRate = Rate / 100
     
218. 
     
219.         ' 执行计算
     
220.         ActiveCell = "=EFFECT(" + PeriodicRate & ",12)"
     
221.     Application.Calculation = xlCalculationAutomatic
     
222.     'Application.Calculation = xlCalculationManual
     
223.         'Application.ActiveWindow.ActiveCell.Calculate()
     
224.     End Sub
     

复制代码