Kredit

Programm zur Berechnung des Kredites. Daten werden in ein Array geschrieben und grafisch ausgegeben.

 

Quellcode:

Option Explicit
Dim dblKredit As Double
Dim dblZinssatz As Double
Dim dblZahlung As Double
Dim dblAbtrag As Double
Dim dblZinsen As Double
Dim dblZinsAlt As Double
Dim dblAbAlt As Double
Dim dblKreditAlt As Double
Dim dblZinsgesamt As Double
Dim dblAbtraggesamt As Double
Dim feld() As Double
Dim i, k As Integer


Private Sub cmdBerechnen_Click()
If IsNumeric(txtKredit.Text) And IsNumeric(txtzins.Text) And IsNumeric(txtzahlung.Text) Then
dblKredit = txtKredit.Text

dblKreditAlt = dblKredit
dblZinssatz = txtzins.Text
dblZahlung = txtzahlung.Text
dblAbtrag = 0
i = 0 'Monate zählen
dblZinsen = 0
dblZinsgesamt = 0
dblAbtraggesamt = 0

If dblKredit <> 0 And dblZinssatz <> 0 And dblZahlung <> 0 And (dblKredit * dblZinssatz * 0.01 / 12) < dblZahlung And dblZahlung < dblKredit Then

'########### Berechnung ###########

Do
i = i + 1
ReDim Preserve feld(1 To 4, 1 To i)
'Berechnung
dblZinsen = dblKredit * dblZinssatz * 0.01 / 12
dblAbtrag = dblZahlung - dblZinsen
dblKredit = dblKredit - dblAbtrag

'Richtigstellung der Negativen Zahlungen
If dblKredit < 0 Then
dblAbtrag = feld(3, (i - 1))
dblZinsen = (-1) * dblKredit * dblZinssatz * 0.01 / 12
dblKredit = 0
End If

feld(1, i) = dblZinsen
feld(2, i) = dblAbtrag
feld(3, i) = dblKredit
feld(4, i) = i

'Gesamtberechnung
dblZinsgesamt = dblZinsgesamt + dblZinsen
dblAbtraggesamt = dblAbtraggesamt + dblAbtrag

Loop Until dblKredit <= 0

cmdausgabe.Enabled = True
cmdgrafik.Enabled = True


Else
MsgBox "Mit der kann nicht gerechnet werden!", vbExclamation, "Fehleingabe"
End If

Else
MsgBox "Bitte Werte inegeben", vbExclamation, "Fehleingabe"
End If

End Sub


Private Sub cmdende_Click()
MsgBox "Ein Computer wird das tun, was Du programmierst - nicht das, was Du willst."
End
End Sub


Private Sub cmdgrafik_Click()
'Alles für Grafik
picAusgabe.Cls
picAusgabe.Scale (0, dblZahlung)-(UBound(feld, 2), 0)

'dblAbAlt = dblZahlung - (dblZinssatz * 0.01 * dblKredit / 12)
'dblKreditAlt = dblKredit
'dblZinsAlt = dblKredit * dblZinssatz * 0.01 / 12

For i = 1 To UBound(feld, 2) Step 1
If i > 1 Then
picAusgabe.Line (i - 1, feld(2, i - 1))-(i, feld(2, i))
picAusgabe.Line (i - 1, feld(1, i - 1))-(i, feld(1, i))
End If
Next i

lblYachseoben.Caption = dblZahlung
lblXachserechts.Caption = UBound(feld, 2)

End Sub


Private Sub cmdLoeschen_Click()
txtKredit.Text = ""
txtzins.Text = ""
txtzahlung.Text = ""
lstAusgabe.Clear
Erase feld()
cmdausgabe.Enabled = False
cmdgrafik.Enabled = False
End Sub


'########### Ausgabe ###########
Private Sub cmdausgabe_Click()
dblZinsen = 0
dblAbtrag = dblAbAlt

lstAusgabe.Clear
lstAusgabe.AddItem "Monat" & vbTab & "Zinsen" & vbTab & "Abtrag" & vbTab & "Rest"
lstAusgabe.AddItem "--------------------------------------------------------"


For i = 1 To UBound(feld, 2) Step 1
lstAusgabe.AddItem " " & i & ": " & vbTab & Format(feld(1, i), "fixed") & vbTab & Format(feld(2, i), "fixed") & vbTab & Format(feld(3, i), "fixed")
'Rausgenommen in SUB !! dblZinsen = dblZinsen + feld(1, i)
dblAbtrag = dblAbtrag + feld(2, i)
Next i

dblZinsen = Gesamtzins()

dblAbtrag = dblAbtrag - dblAbAlt


lstAusgabe.AddItem "----------" & vbTab & "----------" & vbTab & "----------"
lstAusgabe.AddItem " " & UBound(feld, 2) & vbTab & Format(dblZinsen, "fixed") & vbTab & Format(dblAbtrag, "fixed") & vbTab & "<- Gesamtsummen"
lstAusgabe.AddItem "Effektiver Jahreszins: " & Format(Effektivzins(), "fixed") & "%"
lblmonate.Caption = "In " & UBound(feld, 2) & " Monaten müssen insgesamt " & Format(dblZinsen + dblAbtrag, "fixed") & " gezahlt werden"

End Sub


Private Function Gesamtzins()
Gesamtzins = 0
For i = LBound(feld, 2) To UBound(feld, 2) Step 1
Gesamtzins = Gesamtzins + feld(1, i)
Next i
End Function


Private Function Effektivzins()
Dim effekt As Double
'For i = LBound(feld, 2) To UBound(feld, 2) Step 1
' Gesamtzins = Gesamtzins + feld(1, i)
'Next i

Effektivzins = (((dblZinsen / dblKreditAlt) / UBound(feld, 2)) * 12) * 100

End Function

Zu kompliziert??
Dann Download als Projekt (7 KB)

  

Home << Schule << ITA-Mappe << Programmiertechnik Übersicht <<
Online: 1 | IP: | 20.11.2017 - 10:39:23  
©
Christian Klisch   - Alle Rechte vorbehalten - Impressum