Hi,
ich habe eine Excel-Datei, die als Lager dienen soll.
Es soll mir eine E-Mail schicken, wenn ein Artikel entweder unter 1 oder unter 20 kommt. Dabei soll es mir den Artikelnamen ausgeben, sowie den Rest bestand.
Zusätzlich soll es alle Änderungen in der Lager-Tabelle in eine andere Tabelle im gleichen Dokument abspeichern. Also sowas wie eine Protokollierung.
Das Problem dabei ist, dass, wenn eine Änderung vorgenommen wird, kommt die Meldung auf: -> Fehler beim Kompilieren: Mehrfachdeklaration im aktuellen Gültigkeitsbereich
der Code sieht erst mal so aus:
(in den 2 Bereichen in dem die E-Mail hingeschrieben werden soll, steht jetzt mit Absicht nur E-Mail drinnen)
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
' Definieren Sie den Bereich 1: E2:E9, C2:C9 und den Schwellenwert
Set Bereich1 = Me.Range("E2:E9")
Set ProduktRange1 = Me.Range("C2:C9")
BestandThreshold1 = 20
' Definieren Sie den Bereich 2: E11:E51, C11:C51 und den Schwellenwert
Set Bereich2 = Me.Range("E11:E51")
Set ProduktRange2 = Me.Range("C11:C51")
BestandThreshold2 = 1
' Automatische E-Mail-Benachrichtigung Bereich 1
If Not Intersect(Target, Bereich1) Is Nothing Then
If WorksheetFunction.Sum(Bereich1) < BestandThreshold1 Then
Dim ProduktName As String
Dim AktuelleAnzahl As Integer
' Produktname und aktuelle Anzahl ermitteln
ProduktName = ProduktRange1.Cells(Target.Row - ProduktRange1.Cells(1).Row + 1).Value
AktuelleAnzahl = Target.Value
' E-Mail generieren
Dim Betreff1 As String
Dim Nachricht1 As String
Betreff1 = "Bestandsbenachrichtigung: Produkt unter Schwellenwert"
Nachricht1 = "Der Bestand des Produkts " & ProduktName & " beträgt " & AktuelleAnzahl & "."
' E-Mail versenden
SendEmail1 "E-Mail", Betreff1, Nachricht1
End If
End If
' Automatische E-Mail-Benachrichtigung Bereich 2
If Not Intersect(Target, Bereich2) Is Nothing Then
If WorksheetFunction.Sum(Bereich2) < BestandThreshold2 Then
Dim ProduktName As String
Dim AktuelleAnzahl As Integer
' Produktname und aktuelle Anzahl ermitteln
ProduktName = ProduktRange2.Cells(Target.Row - ProduktRange2.Cells(1).Row + 11).Value
AktuelleAnzahl = Target.Value
' E-Mail generieren
Dim Betreff2 As String
Dim Nachricht2 As String
Betreff2 = "Bestandsbenachrichtigung: Produkt unter Schwellenwert"
Nachricht2 = "Der Bestand des Produkts " & ProduktName & " beträgt " & AktuelleAnzahl & "."
' E-Mail versenden
SendEmail2 "E-Mail", Betreff2, Nachricht2
End If
End If
' Protokollierung
If Target.Worksheet.Name = "Lager" Then
Dim ProtokollSheet As Worksheet
Dim letzteZeile As Long
Dim Benutzer As String
Dim Aktion As String
' Definieren Sie das Protokollblatt
Set ProtokollSheet = ThisWorkbook.Sheets("Protokoll")
' Bestimmen Sie die letzte Zeile im Protokollblatt
letzteZeile = ProtokollSheet.Cells(ProtokollSheet.Rows.Count, 1).End(xlUp).Row + 1
' Benutzername erfassen
Benutzer = Application.UserName
' Aktion erfassen
Aktion = "Änderung: " & Target.Address & " - Neuer Wert: " & Target.Value
' Protokolldatum erfassen
ProtokollSheet.Cells(letzteZeile, 1).Value = Now()
' Benutzer, geänderte Zelle und Änderung protokollieren
ProtokollSheet.Cells(letzteZeile, 2).Value = Benutzer
ProtokollSheet.Cells(letzteZeile, 3).Value = Target.Address
ProtokollSheet.Cells(letzteZeile, 4).Value = Aktion
' Speichern Sie das Protokollblatt
ThisWorkbook.Save
End If
End Sub
Sub SendEmail1(ByVal MailAdresse As String, ByVal Betreff As String, ByVal Nachricht As String)
' Code zum Senden der E-Mail (Bereich 1)
' ...
End Sub
Sub SendEmail2(ByVal MailAdresse As String, ByVal Betreff As String, ByVal Nachricht As String)
' Code zum Senden der E-Mail (Bereich 2)
' ...
End Sub
|