第14週Word+EXCEL recording macro錄製巨集+金融計算

 

VERSION 5.00

Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} UserForm1

   Caption         =   "劉任昌"

   ClientHeight    =   4320

   ClientLeft      =   105

   ClientTop       =   450

   ClientWidth     =   8565.001

   OleObjectBlob   =   "UserForm1.frx":0000

   StartUpPosition =   1  '所屬視窗中央

End

Attribute VB_Name = "UserForm1"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = True

Attribute VB_Exposed = False

 

Dim n As Integer

Dim spec As String

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

  n = n + 1 '第幾次計算+1

  a = 0     '報酬率0

  b = 1     '報酬率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 < 0 Then

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

  Else

     Do While gap > mexerror And Abs(f) > maxerror And loopNumber < 100

       loopNumber = loopNumber + 1

       c = (a + b) / 2

       f = npv(c)

       If Abs(f) > maxerror And gap > maxerror Then

          If f > 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

  spec = "躉繳$" & payment(0) & ", 第1期$" & payment(1) & ",第2期$" & payment(2) & ",第3期$" & payment(3)

  Selection.TypeText ("第" & n & "次執行")

  Selection.TypeParagraph

  Selection.TypeText (spec)

  Selection.TypeParagraph

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

  Selection.TypeParagraph

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

  Selection.TypeParagraph

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

  Selection.TypeParagraph 'typewriter打字機paragraph段落

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 CommandButton3_Click()

  Selection.WholeStory

  Selection.Delete

End Sub

 

Private Sub CommandButton4_Click()

Selection.WholeStory

  Selection.Delete

End Sub

 

Private Sub CommandButton5_Click()

Selection.Font.Bold = True

 Selection.Font.Size = 24

Selection.Font.Bold = wdToggle

End Sub