'® Albert Pichler bankdirekt.at
   'Europaplatz 1a, 4021 Linz  pichler@bankdirekt.at
   
    option explicit
    
    Datum.VTag.value= day(date())
    Datum.VMonat.value= month(date())
    Datum.VJahr.value= year(date())

    Datum.Tag.value = day(date())
    Datum.Monat.value = month(date())
    Datum.Jahr.value = year(date())

Function fmt(x)
'	rundet auf 2 Stellen
   dim rounded, decimalpos
   dim euros, cents
   dim eurolength, negativeflag
 

    If Not IsNumeric(x) Then 
		fmt="***"
		Exit Function
	End if

'	Beenden, wenn Zahl zu groß
	if x > 10000000 or x < -10000000 then
		fmt="****"
        Exit Function
    End If

'   Zahl auf zwei Dezimalstellen abrunden
    Rounded = CLng(x * 100) / 100
    DecimalPos = InStr(Rounded, ",")
    Select Case DecimalPos
        Case 0
            euros = Rounded
            Cents = "00"
        Case Else
            euros = Left(Rounded, DecimalPos - 1)
            Cents = Right(Rounded, Len(Rounded) - DecimalPos)
            If Len(Cents) = 0 Then Cents = "00"
            If Len(Cents) = 1 Then Cents = Cents & "0"
    End Select

	If euros <0 then NegativeFlag=1 else NegativeFlag=0
	euros=abs(euros)
	euroLength=Len(euros)

	If NegativeFlag = 1 then
		fmt = "-" & euros & "," & Cents 
	else
	    fmt = " " & euros & "," & Cents
	end if
End Function



function Kurs (kup, zs, rk, lauf, yld, stzs)
       dim x, y, z, b
       dim i, j, ff
       dim pos

       x = zs * lauf
       y = int(x)

       if (x - y) >= 1/360 then
         stzs = kup / zs * (1 - (x-y))      
         y = y + 1
       else
         stzs = 0
       end if
       b = y - zs * lauf
       if b < 0 then 
          b = 0
       end if
       j = (1 + yld/100) ^ (1 / zs)
       ff = j ^ b
       Kurs = ff * (kup / zs * (j ^ y - 1) / (j-1) / j ^ y + rk / j ^ y) - stzs
end function

function BW (ku, kup, zs, rk, lauf, yld, stzs)
      bw = ku - kurs (kup, zs, rk, lauf, yld, stzs)
end function

function yield (ku, kup, zs, rk, lauf, yld, stzs)
     dim delta
     dim x, y, z
     dim kk
     dim r1, r0, bwr, bwplus, bwminus, rr
     
     delta = 0.0001
     kk = ku
     rr = yld
     
     do
      r0 = rr
      bwr = bw (kk, kup, zs, rk, lauf, r0, stzs)
      r0 = rr + delta
      bwplus = bw (kk, kup, zs, rk, lauf, r0, stzs)
      r0 = rr - delta
      bwminus = bw (kk, kup, zs, rk, lauf, r0, stzs)
      r1 = rr - bwr / ((bwplus - bwminus)/ 2 / delta)
      if abs(r1-rr) < delta then
        yield = r1
        exit function
      else
        rr = r1
      end if
     loop

end function


sub CALC_onclick()
      dim x, y, z , d
      dim i, j
      dim htag, hmonat, hjahr 
      dim ftag, fmonat, fjahr 
      dim kup, lauf, yld, rk , k, ka
      dim zs, qf
      dim va, vf, ku, stzs

     'Datum aktuell
      htag = Datum.vtag.value
      if htag > 30 then
        htag = 30
      end if
      hmonat = Datum.vmonat.value
      hjahr = Datum.vjahr.value
      va = dateserial(hjahr, hmonat, htag)

     'Fälligkeitsdatum
      ftag = Datum.tag.value
      if ftag > 30 then
       ftag = 30
      end if
      fmonat = Datum.monat.value
      fjahr = Datum.jahr.value
      vf = dateserial(fjahr, fmonat, ftag)

      kup = Konditionen.kupon.value
      zs = Konditionen.zspa.value
      rk = Konditionen.rk.value
      k = Konditionen.kurs.value
      x = instr(k,",")    
 

      if vf <= va then
        alert "Valuta- oder Tilgungsdatum ungültig !"
        exit sub
      else
        vf = 360 * fjahr + 30 * fmonat + ftag
        va = 360 * hjahr + 30 * hmonat + htag 
        lauf = (vf - va) / 360
        yld = (kup + (rk - k) / lauf) / k * 100 
      ' alert "TEST Zwischenrendite "& yld
               ku = k
        qf = yield (ku, kup, zs, rk, lauf, yld, stzs)
        Ergebnisse.Yld.value = fmt(qf)    
        Ergebnisse.Laufzeit.value = fmt(Lauf)
        Ergebnisse.Stueckzins.value = fmt(stzs)
      end if 	 
	   
	  dim cbox
	  cbox = Konditionen.Wohnbau.checked
	  
	  if ((kup<=4) AND (cbox)) then
	  	 'alert("s1")
		kup=kup
	  	   			
	          	
           
	  else
	  	' JETZT die Rendite nach KEST mit 25 % KESt - Wohnbauanleihen mit 4 % Kestfrei 	  	
		  'alert("s2")
		  if ((kup>4) AND (cbox)) then
		  	kup=kup -((kup-4)*25/100)
			else
			 'alert("s3")
		   		kup=kup - (kup*25/100)
		  end if	
	  end if
	  
	   'alert(kup)
    
	  if vf <= va then
        alert "Valuta- oder Tilgungsdatum ungültig !"
        exit sub
      else
        vf = 360 * fjahr + 30 * fmonat + ftag
        va = 360 * hjahr + 30 * hmonat + htag 
        lauf = (vf - va) / 360
        yld = (kup + (rk - k) / lauf) / k * 100 
      'alert "TEST Zwischenrendite KESt "& yld
               ku = k
        qf = yield (ku, kup, zs, rk, lauf, yld, stzs)
        Ergebnisse.KestRendite.value = fmt(qf)    
      end if

end sub