Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Schenkungssteuern in einer UserForm berechnen

Gruppe

TextBox

Problem

Über einen UserForm-Dialog werden Erbschafts- und Schenkungssteuern berechnet und in die Liste eingetragen.

Lösung
Geben Sie den Ereigniscode in das Klassenmodul der UserForm ein.

ClassModule: Tabelle1

Dim NumWert
Dim NumSatz
Dim NumSteuer

Private Sub CbxErbe_Change()

Worksheets("Hilfsfelder").Visible = True
Worksheets("Hilfsfelder").Activate
Range("A1").Select
ActiveCell.Value = FrmErbe.CbxErbe
Range("B1").Select
FrmErbe.TbxSteuerkl.Value = ActiveCell.Value

End Sub

Private Sub CommandButton1_Click()

Worksheets("Tabelle1").Activate
Rows("3:3").Select
Selection.Insert Shift:=x1Down
Range("A3").Select

Range("A3").Select
ActiveCell.Value = FrmErbe.CbxErbe
Range("B3").Select
ActiveCell.Value = FrmErbe.TbxSteuerkl
Range("C3").Select
ActiveCell.Value = CDbl(NumWert)
Range("D3").Select
ActiveCell.Value = CDbl(NumSatz)
Range("F3").Select
ActiveCell.Value = CDbl(NumSteuer)
FrmErbe.Hide

End Sub

Private Sub TbxSatz_Change()

NumWert = FrmErbe.TbxWert
NumSatz = FrmErbe.TbxSatz
If NumWert <> "" Then
If NumSatz <> "" Then
    NumSteuer = NumWert * NumSatz
End If
End If
FrmErbe.TbxSteuer.Value = NumSteuer

End Sub
    

Private Sub TbxSatz_AfterUpdate()

FrmErbe.TbxSatz.Text = Format(NumSatz, "#,##0.00")
FrmErbe.TbxSteuer.Text = Format(NumSteuer, "#,##0.00")

End Sub

StandardModule: basMain

Sub CallForm()
   FrmErbe.Show
End Sub

Sub EinAusblenden()
   With wksData
      If .Visible = xlSheetVeryHidden Then
         .Visible = xlSheetVisible
      Else
         .Visible = xlSheetVeryHidden
      End If
   End With
End Sub
ClassModule: frmErbe

Private Sub cmdCancel_Click()
   Unload Me
End Sub

Private Sub cboErbe_Change()
   If cboErbe.Value = "Eltern und Großeltern" Then
      Frame1.Visible = True
   Else
      Frame1.Visible = False
   End If
   Call SteuerBerechnen
End Sub

Private Sub cmdEintragen_Click()
   Dim iRow As Integer
   Dim sValue As String
   iRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
   sValue = txtSatz.Text
   sValue = WorksheetFunction.Substitute(sValue, " %", "")
   Cells(iRow, 1).Value = cboErbe.Value
   Cells(iRow, 2).Value = txtStkl.Text
   Cells(iRow, 3).Value = CDbl(txtWert.Text)
   Cells(iRow, 4).Value = CDbl(sValue) / 100
   Cells(iRow, 5).Value = CDbl(txtSteuer.Text)
End Sub

Private Sub optErbschaft_Change()
   Call SteuerBerechnen
End Sub

Private Sub txtWert_Exit(ByVal Cancel As MSForms.ReturnBoolean)
   txtWert.Text = Format(txtWert.Text, "#,##0")
   Call SteuerBerechnen
End Sub

Private Sub txtWert_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
   If IsNumeric(Chr(KeyCode)) = False And KeyCode <> 9 And KeyCode <> 13 Then
      KeyCode = 0
   End If
End Sub

Private Sub UserForm_Initialize()
   cboErbe.List = wksData.Range("Liste").Value
End Sub

Private Sub SteuerBerechnen()
   Dim lSerw As Long
   Dim dSatz As Double
   Dim iRow As Integer, iCol As Integer
   If cboErbe.Value = "" Then Exit Sub
   iRow = WorksheetFunction.Match(cboErbe.Value & "*", wksData.Columns(7), 0)
   For iCol = 8 To 10
      If Not IsEmpty(wksData.Cells(iRow, iCol)) Then Exit For
   Next iCol
   If InStr(cboErbe.Value, "Eltern und Großeltern") Then
      If optSchenkung Then
         iRow = iRow + 1
         iCol = iCol + 1
      End If
   End If
   txtStkl.Text = wksData.Cells(2, iCol).Value
   txtFrei.Text = Format(wksData.Cells(iRow, iCol).Value, "#,##0")
   If txtWert = "" Then Exit Sub
   lSerw = CDbl(txtWert.Text) - CDbl(txtFrei.Text)
   If lSerw > 0 Then
      txtSerw.Text = Format(CDbl(txtWert.Text) - CDbl(txtFrei.Text), "#,##0")
      iRow = WorksheetFunction.Match(CDbl(txtSerw.Text), wksData.Columns(2), 1)
      iCol = WorksheetFunction.Match(txtStkl.Text, wksData.Rows(2), 0)
      dSatz = wksData.Cells(iRow, iCol).Value
      txtSatz.Text = Format(dSatz, "0.00 %")
      txtSteuer.Text = Format(CDbl(txtSerw.Text) * dSatz, "#,##0")
   Else
      txtSerw.Text = "0"
      txtSatz.Text = "0"
      txtSteuer.Text = "0"
   End If
End Sub