Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Bewerten Sie hier bitte das Excel-Portal

Home Zurück Vor

Download Beispiel-Arbeitsmappe

Thema

Markierten Bereich mit jeweiligem Mwst-Satz multiplizieren

Gruppe

Berechnen

Problem

Wie kann ich aus einer Liste von Mehrwertsteuersätzen einen Satz auswählen und dann einem zu markierenden Bereich diese Mwst. hinzufügen?

Lösung

Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.

ClassModule: DieseArbeitsmappe

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   On Error Resume Next
   Application.CommandBars("Standard").Controls("Multiplizieren").Delete
   On Error GoTo 0
End Sub

Private Sub Workbook_Open()
   Dim objButton As CommandBarButton
   On Error Resume Next
   Application.CommandBars("Standard").Controls("Multiplizieren").Delete
   On Error GoTo 0
   Set objButton = Application.CommandBars("Standard").Controls.Add
   With objButton
      .Caption = "Multiplizieren"
      .Style = msoButtonIcon
      .FaceId = 1088
      .OnAction = "Multiplizieren"
   End With
End Sub

ClassModule: Tabelle3

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
   Dim rngAct As Range
   If Application.CommandBars("Standard") _
      .Controls("Multiplizieren").State = msoButtonDown Then
      If Target.Column <> 3 Then
         Beep
         MsgBox "Sie müssen Zellen in Spalte C markieren!"
         Exit Sub
      End If
      For Each rngAct In Selection.Cells
         rngAct = rngAct.Offset(0, -1) * dMultiplicator
         rngAct.Offset(0, 1) = rngAct.Offset(0, -1) + rngAct
      Next rngAct
   End If
   Application.CommandBars("Standard") _
      .Controls("Multiplizieren").State = msoButtonUp
End Sub

StandardModule: basMain

Public dMultiplicator As Double

Sub Multiplizieren()
   If Intersect(ActiveCell, Range("A2:A6")) Is Nothing Then
      Beep
      MsgBox "Sie müssen sich im Bereich A2:A6 befinden!"
      Exit Sub
   End If
   If Selection.Cells.Count > 1 Then
      Beep
      MsgBox "Es darf nur eine Zelle markiert sein!"
      Exit Sub
   End If
   CommandBars("Standard").Controls("Multiplizieren").State = msoButtonDown
   dMultiplicator = ActiveCell
End Sub