Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich1 As Range
Dim Bereich2 As Range
Dim ProduktRange1 As Range
Dim ProduktRange2 As Range
Dim BestandThreshold1 As Integer
Dim BestandThreshold2 As Integer
Set Bereich1 = Me.Range("E2:E9")
Set ProduktRange1 = Me.Range("C2:C9")
BestandThreshold1 = 20
Set Bereich2 = Me.Range("E11:E51")
Set ProduktRange2 = Me.Range("C11:C51")
BestandThreshold2 = 1
If Not Intersect(Target, Bereich1) Is Nothing Then
If WorksheetFunction.Sum(Bereich1) < BestandThreshold1 Then
Dim ProduktName As String
Dim AktuelleAnzahl As Integer
ProduktName = ProduktRange1.Cells(Target.Row - ProduktRange1.Cells(1).Row + 1).Value
AktuelleAnzahl = Target.Value
Dim Betreff1 As String
Dim Nachricht1 As String
Betreff1 = "Bestandsbenachrichtigung: Produkt unter Schwellenwert"
Nachricht1 = "Der Bestand des Produkts " & ProduktName & " beträgt " & AktuelleAnzahl & "."
SendEmail1 "E-Mail", Betreff1, Nachricht1
End If
End If
If Not Intersect(Target, Bereich2) Is Nothing Then
If WorksheetFunction.Sum(Bereich2) < BestandThreshold2 Then
Dim ProduktName As String
Dim AktuelleAnzahl As Integer
ProduktName = ProduktRange2.Cells(Target.Row - ProduktRange2.Cells(1).Row + 11).Value
AktuelleAnzahl = Target.Value
Dim Betreff2 As String
Dim Nachricht2 As String
Betreff2 = "Bestandsbenachrichtigung: Produkt unter Schwellenwert"
Nachricht2 = "Der Bestand des Produkts " & ProduktName & " beträgt " & AktuelleAnzahl & "."
SendEmail2 "E-Mail", Betreff2, Nachricht2
End If
End If
If Target.Worksheet.Name = "Lager" Then
Dim ProtokollSheet As Worksheet
Dim letzteZeile As Long
Dim Benutzer As String
Dim Aktion As String
Set ProtokollSheet = ThisWorkbook.Sheets("Protokoll")
letzteZeile = ProtokollSheet.Cells(ProtokollSheet.Rows.Count, 1).End(xlUp).Row + 1
Benutzer = Application.UserName
Aktion = "Änderung: " & Target.Address & " - Neuer Wert: " & Target.Value
ProtokollSheet.Cells(letzteZeile, 1).Value = Now()
ProtokollSheet.Cells(letzteZeile, 2).Value = Benutzer
ProtokollSheet.Cells(letzteZeile, 3).Value = Target.Address
ProtokollSheet.Cells(letzteZeile, 4).Value = Aktion
ThisWorkbook.Save
End If
End Sub
Sub SendEmail1(ByVal MailAdresse As String, ByVal Betreff As String, ByVal Nachricht As String)
End Sub
Sub SendEmail2(ByVal MailAdresse As String, ByVal Betreff As String, ByVal Nachricht As String)
End Sub