第十三週WOORD VBA+TypeText

 

<div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiB7yMbqTZOGCk7CWxCNnMrVclKCI2Fjnp99TU2aFj4Z-QmRpo0Wb2eIbwsRuMf_qKAln0dFgjCMJ2lS4tr4fu5bPxHLwdERShX0BD9N-yiYdo9AWXeF4G8PZyS4HO70vuInXqvC7iFh4Fm/s881/%25E6%2593%25B7%25E5%258F%2596.JPG" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" data-original-height="364" data-original-width="881" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiB7yMbqTZOGCk7CWxCNnMrVclKCI2Fjnp99TU2aFj4Z-QmRpo0Wb2eIbwsRuMf_qKAln0dFgjCMJ2lS4tr4fu5bPxHLwdERShX0BD9N-yiYdo9AWXeF4G8PZyS4HO70vuInXqvC7iFh4Fm/s320/%25E6%2593%25B7%25E5%258F%2596.JPG" width="320" /></a></div><br /><div><br /></div>Const period As Integer = 4

Const maxerror As Double = 0.0000001

Dim payment(period) As Double '廣域變數 4 維度的陣列

Private Sub CommandButton1_Click()

  Dim a, b, c, f, gap As Double

  Dim loopNumber As Integer

  a = 0

  b = 1

  gap = 10

  loopNumber = 10

  payment(0) = TextBox1.Value

  payment(1) = TextBox2.Value

  payment(2) = TextBox3.Value

  payment(3) = TextBox4.Value

  f = npv(a)

  If f = 0 Then

     Label9.Caption = 0

  ElseIf f &lt; 0 Then

     Label9.Caption = "內部報酬率小於 0."

  Else

     Do While gap &gt; mexerror And Abs(f) &gt; maxerror And loopNumber &lt; 300

       loopNumber = loopNumber + 1

       c = (a + b) / 2

       f = npv(c)

       If Abs(f) &gt; maxerror And gap &gt; maxerror Then

          If f &gt; 0 Then

            a = c

          Else

            b = c

            gap = b - a

          End If

        Else

          Label9.Caption = c

       End If

     Loop

  End If

  Label10.Caption = f

  Label11.Caption = loopNumber

  '以下是將結果輸出到 WORD 文件

  Selection.TypeText ("躉繳:" &amp; TextBox1.Value &amp; ", 第1期:" &amp; TextBox2.Value &amp; ", 第2期:" &amp; TextBox3.Value &amp; ", 第3期:" &amp; TextBox4.Value)

  Selection.TypeParagraph

  Selection.TypeText ("內部報酬率:" &amp; c)

  Selection.TypeParagraph

  Selection.TypeText ("淨現值:" &amp; f)

  Selection.TypeParagraph

  Selection.TypeText ("迴圈次數:" &amp; loopNumber)

  Selection.TypeParagraph

End Sub

Private Sub CommandButton2_Click()

  End

End Sub

Function npv(rate) '計算特定折現率rate的淨現值

  Dim y As Double

  Dim j As Integer

  y = -payment(0)

  For j = 1 To period

      y = y + payment(j) / (1 + rate) ^ j

  Next

  npv = y

End Function

Private Sub UserForm_Click()

End Sub