Programmierung - meldung bei Mindestbestand

Hallo liebe Leute,
ich habe ein Problem dass ich ohne euch nicht lösen kann.
Zur Zeit mache ich meine Technikerarbeit in einem großen Betrieb. 17000 Mitarbeiter. Der Standort an dem ich arbeite ist aber eher klein ca 300 Mitarbeiter. Ich soll ein neues Verwaltungssystem von Messmitteln erstellen und da stehe ich jetzt vor einem Problem oder einer Frage:
Ich werde eine Bestandsliste in Excel erstellen. Wenn ein Messmittel kaputt gehen sollte dann wird der Verantwortliche in dieser Excel Liste den Bestand aktualisieren. Wenn es dann irgendwann in den "roten" Bereich gehen sollte bei dem man dann schon neue nachbestellen muss, würde ich gerne haben dass eine Nachricht per email oder was es sonst noch gibt an den Meister geht. Entweder nur die Info dass man nachbestellen muss oder irgendwie ein Screenshot von der Excel Liste oder so...
könnt ihr mir da weiter helfen?
Danke jetzt schon mal =)
LG

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Private Sub Worksheet_Change(ByVal Target As Range) Dim User$, AnWen$, Subj$, Bodytxt$ Dim Art$, Bes$ Dim Sp1%, Sp2%, Sp3%, Sp4% ' anpassen Sp1 = 1 'Spalte, in der der Artikel steht Sp2 = 2 'Spalte, in der die Bezeichnung steht Sp3 = 3 'Spalte, in der der Bestand eingegeben wird Sp4 = 4 'Spalte, in der die Mindestbestand steht Sp5 = 5 'Splate, in der die Deckung gerechnet wird On Error GoTo Fehler If Not Intersect(Target, Columns(Sp3)) Is Nothing Then ' nur bei Änderungen in C If Cells(Target.Row, Sp5) 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear Application.EnableEvents = True Application.DisplayAlerts = True End Sub Sub Mail_senden(AnWen$, Subj$, Bodytxt$) Dim olApp As Object Set olApp = CreateObject("Outlook.Application") With olApp.CreateItem(0) 'Empfänger .Recipients.Add AnWen 'Betreff .Subject = Subj 'Nachricht .Body = Bodytxt 'Lesebestätigung aus .ReadReceiptRequested = False 'Dateianhang .Send End With Set olApp = Nothing End Sub

Hallo nochmal
ich habe es in die Datei eingebaut.
- Variante 2 ohne Spalte Deckung
- die rote Kennzeichnung über bedingte Markierung
- Der Benutzer selbst bekommt auch noch einen Hinweis
https://www.herber.de/bbs/user/81717.xlsm
Tabelle1

	A	B	C	D	E	F	G
1	Equipment	Bezeichnung	InventarNr	Hersteller	Bestand	Mindestmenge	sonstiges
2	'37	HOEHENREISSER	H800	Mitutoya	4	5
3	'106	MESSSCHIEBER	K720	LEITZ	3	3
4	'570	DREHMOMENTSCHLUESSEL	F830	BELZER	1	2
5	'915	GEWINDELEHRRING (AS)	G774	STIEFELMAYER	5	4
6	'923	GEWINDEGRENZLEHRDORN	F830	STIEFELMAYER	7	5
7	'1246	GEWINDELEHRRING	M652	STIEFELMAYER	1	1
8

Bedingte Formatierung wird in dieser Tabelle nicht dargestellt

bedingte Formatierung
Zelle	Typ	Operator	Formel1	Formel2	Format	Unterstrichen	Schrift- farbe	Muster	Muster- farbe
E2:E7	1.Bed.: Formel ist		=$E2-$F2<0		255

Die Bedingungen wurden mit Excel-Version ab 2007 ausgelesen
Durch die veränderte Bedingte Formatierung kann es vorkommen, dass Bedingungen falsch ausgelesen werden

http://excel-inn.de/dateien/vba_beispiele/tabellenanzeige_in_html_addin.zip Tabellendarstellung in Foren Version 5.49

den Code findest du so:
- in Excel einen Rechtsclick auf den Tabellenblattreiter (hier Tabelle1)
- Code anzeigen
- in dem neuen Fenster rechts
Userbild

Private Sub Worksheet_Change(ByVal Target As Range)
Dim User$, AnWen$, Subj$, Bodytxt$
Dim Art$, Bes$
On Error GoTo Fehler
If Not Intersect(Target, Columns(5)) Is Nothing Then ' nur bei Änderungen in E
If Cells(Target.Row, 5) - Cells(Target.Row, 6)  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
Sub Mail_senden(AnWen$, Subj$, Bodytxt$)
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
'Empfänger
.Recipients.Add AnWen
'Betreff
.Subject = Subj
'Nachricht
.Body = Bodytxt
'Lesebestätigung aus
.ReadReceiptRequested = False
'Dateianhang
.Send
End With
Set olApp = Nothing
End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim User$, AnWen$, Subj$, Bodytxt$ Dim Art$, Bes$ On Error GoTo Fehler If Not Intersect(Target, Columns(5)) Is Nothing Then ' nur bei Änderungen in E If Cells(Target.Row, 5) - Cells(Target.Row, 6) 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear Application.EnableEvents = True Application.DisplayAlerts = True End Sub Sub Mail_senden(AnWen$, Subj$, Bodytxt$) Dim olApp As Object Set olApp = CreateObject("Outlook.Application") With olApp.CreateItem(0) 'Empfänger .Recipients.Add AnWen 'Betreff .Subject = Subj 'Nachricht .Body = Bodytxt 'Lesebestätigung aus .ReadReceiptRequested = False 'Dateianhang .Send End With Set olApp = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

	A	B	C	D	E
1	Artikel	Bezeichnung	Bestand	Mindestmenge	Deckung
2	4711	Messschieber 0-125	25	15	10
3	4712	Innenmessdorn D=20 H7	3	5	-2
4
5
6
7

verwendete Formeln
Zelle	Formel	Bereich
E2	=C2-D2
E3	=C3-D3

Programmierung - meldung bei Mindestbestand

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread