VBA - USER DEFINED FUNCTIONS

STEUERN

  Option Explicit
' Berechnet steuerlich relevante Werte
Const UStV = 16
Const UStE = 7
Const UstA = 15

Public Function USt(Brutto As Single) As Single
USt = Brutto / (100 + UStV) * UStV
End Function

Public Function Netto(Brutto As Single) As Single
Netto = Brutto / (100 + UStV) * 100
Netto = Netto
End Function

Public Function Netto2(Brutto As Single) As Single
Netto2 = Brutto - USt(Brutto)
End Function

Public Function USt_nach_Jahr(Brutto As Single, Optional UstDatum) As Single
If IsMissing(UstDatum) Then UstDatum = Date
If VarType(UstDatum) <> 7 Then UstDatum = Date
If UstDatum <= #3/31/1998# Then
    USt_nach_Jahr = Brutto / (100 + UstA) * UstA
Else
    USt_nach_Jahr = Brutto / (100 + UStV) * UStV
End If
End Function

Public Function USt_nach_Jahr2(Brutto As Single, Optional UstDatum) As Single
' Umgeschreiben auf IIF-Funktion
Dim UStSatz As Single
UstDatum = IIf(IsMissing(UstDatum), Date, UstDatum)
UStSatz = IIf(UstDatum <= #3/31/1998#, 15, 16)
USt_nach_Jahr2 = Brutto / (100 + UStSatz) * UStSatz
End Function

Public Function Brutto(NettoBetrag As Single) As Single
Brutto = NettoBetrag * (1 + UStV / 100)
End Function

Public Function USt_Satz(UstDatum As Date) As Single
If UstDatum <= #3/31/1997# Then
    USt_Satz = UstA
Else
    USt_Satz = UStV
End If
End Function

Function UstNachTyp(Netto As Double, Typ As String) As Double
Typ = UCase(Typ) ' alles in Versalien
Select Case Typ
    Case "V" ' voller UST-Satz
        UstNachTyp = 0.16
    Case "E" ' ermässigter UST-Satz
        UstNachTyp = 0.07
    Case "A" ' alter UST-Satz
        UstNachTyp = 0.15
    Case Else ' alle sonstigen Fälle
        UstNachTyp = 0
End Select
Netto = Netto * UstNachTyp
End Function

Function GESt_Rückstellung(GewerbeErtrag As Double, HebeSatz As Single, Optional FreibetragJaNein) As Double
' Standard für Freibetragsberechnung ist JA (=bereits eingerechnet)
FreibetragJaNein = IIf(IsMissing(FreibetragJaNein), True, FreibetragJaNein)
FreibetragJaNein = IIf(FreibetragJaNein = "JA" Or FreibetragJaNein Or _
FreibetragJaNein = "WAHR", True, False)
Dim FreiBetrag As Single
FreiBetrag = IIf(FreibetragJaNein, 0, 48000)
GewerbeErtrag = GewerbeErtrag - FreiBetrag
GESt_Rückstellung = GewerbeErtrag * GESt_faktisch(HebeSatz)
End Function

Function GESt_faktisch(HebeSatz As Single)
Dim messbetrag As Single
messbetrag = 0.05 ' 5%
GESt_faktisch = (HebeSatz * messbetrag) / (1 + (HebeSatz * messbetrag))
End Function

Function GrSt(VerkaufsPreis As Double, HebeSatz As Single) As Double
GrSt = VerkaufsPreis * 0.002 * HebeSatz
End Function