Private Sub Abbrechen_Click()
UserformSchließen (False)
End Sub
Private Sub Anforderung_erstellen_Button_Click()
'Prüfen, ob alle elevanten Daten eingegeben wurden
If Benutzername.Text = "" Or Abteilung.Text = "" Or Bezeichnung.Text = "" Or Beschreibung. _
Text = "" Or Fehlerattribut.Value = "" Or (Fehlerattribut.Value = "Fehlerort konstruktiv" And Sachnummer = "") Then
MsgBox ("Sie haben nicht alle Felder ausgefüllt!")
'Überprüfen, ob das Feld Sachnummer korrekt ausgefüllt ist
ElseIf (Fehlerattribut.Value = "Fehlerort konstruktiv") And (Sachnummer.TextLength 7 Or _
IsNumeric(Sachnummer.Text) = False) Then
MsgBox ("Sie haben das Feld 'Sachnummer' nicht korrekt ausgefüllt. Es muss eine 7- _
stellige Zahl eingegeben werden!")
Else
'Blattschutz aufheben
Sheets("Anforderungen").Unprotect Password:="39wPqg2h"
'Neue Zeile in Zeile 6 einfügen und den Rest nac unten verschieben
Sheets("Anforderungen").Rows(6).Insert Shift:=xlDown, CopyOrigin:= _
xlFormatFromRightOrBelow
'Daten in die Liste schreiben
Sheets("Anforderungen").Cells(6, 1) = Date
Sheets("Anforderungen").Cells(6, 2) = Format(Benutzername.Text)
Sheets("Anforderungen").Cells(6, 3) = Format(Abteilung.Text)
Sheets("Anforderungen").Cells(6, 4) = Format(Fehlerattribut.Text)
Sheets("Anforderungen").Cells(6, 5) = Format(Sachnummer.Text)
Sheets("Anforderungen").Cells(6, 6) = Format(Bezeichnung.Text)
Sheets("Anforderungen").Cells(6, 7) = Format(Beschreibung.Text)
Sheets("Anforderungen").Cells(6, 8) = "angefordert"
mail
UserformSchließen (True)
End If
End Sub
Private Sub Fehlerattribut_Change()
'Wenn als Fehlerattribut FO K, dann das Feld Sachnummer aktivieren
If Fehlerattribut.Value = "Fehlerort konstruktiv" Then
Sachnummer.Enabled = True
Sachnummer.BackColor = &H80000005
'Wenn ein anderes Fehlerattribut gewählt ist, Feld Sachnummer deaktivieren
Else
Sachnummer.BackColor = &H80000003
Sachnummer.Text = ""
Sachnummer.Enabled = False
End If
End Sub
Private Sub UserForm_Initialize()
'Variable deklarieren
Dim Wiederholungen As Integer
'Schleife zum Füllen der Dropdown-Liste "Fehlerattribute" mit den Daten aus Blatt " _
Hilfstabelle"
'Spalte A ab Zeile 2 bis zur letzten gefüllten Zeile
For Wiederholungen = 2 To Sheets("Hilfstabelle").Range("A65536").End(xlUp).Row
Fehlerattribut.AddItem Sheets("Hilfstabelle").Cells(Wiederholungen, 1)
Next
End Sub
Private Sub UserformSchließen(speichern As Boolean)
'Windows Benutzername auslesen
Dim Benutzername As String
Benutzername = Environ("Username")
Dim Wiederholungen As Integer
Dim admin As Boolean
admin = False
Dim eingeschränkt As Boolean
eingeschränkt = False
'Überprüfen, ob in der Liste "Admin-Benutzer" auf dem Blatt "Hilfstabelle" der Benutzer _
enthalten ist, der geerade das Blatt geöffnet hat
For Wiederholungen = 2 To Sheets("Hilfstabelle").Range("A65536").End(xlUp).Row
If Sheets("Hilfstabelle").Cells(Wiederholungen, 2) = Benutzername Then
admin = True
End If
Next
'Überprüfen, ob in der Liste "Admin-Benutzer" auf dem Blatt "Hilfstabelle" der Benutzer _
enthalten ist, der geerade das Blatt geöffnet hat
For Wiederholungen = 2 To Sheets("Hilfstabelle").Range("A65536").End(xlUp).Row
If Sheets("Hilfstabelle").Cells(Wiederholungen, 3) = Benutzername Then
eingeschränkt = True
End If
Next
'Wenn Benutzername in Hilfstabelle enthalten, Blattschutz aufheben
If admin = True Then
Sheets("Anforderungen").Unprotect Password:="39wPqg2h"
Sheets("Hilfstabelle").Unprotect Password:="39wPqg2h"
Sheets("Hilfstabelle").Visible = True
'Wenn Benutzername in der Spalte "Anforderungen bearbeitbar" der Hilfstabelle enthalten, _
Anforderungen zum bearbeiten freigeben
ElseIf eingeschränkt = True Then
Sheets("Anforderungen").Unprotect Password:="39wPqg2h"
Else
'Blattschutz wieder aktivieren
Sheets("Anforderungen").Protect userinterfaceonly:=True, Password:="39wPqg2h"
Sheets("Anforderungen").EnableAutoFilter = True
End If
'Userform schließen
Unload Me
If speichern = True Then
If ThisWorkbook.Saved = False Then
ThisWorkbook.Save
ThisWorkbook.Saved = True
End If
End If
End Sub
'Sub zum Versenden der EMail wenn ein neuer Eintrag erstellt wurdeSub mail()
Dim empfänger As String
'Empfänger aus der Hilfstabelle auslesen
empfänger = ""
For Wiederholungen = 2 To Sheets("Hilfstabelle").Range("A65536").End(xlUp).Row
If empfänger = "" Then
empfänger = Sheets("Hilfstabelle").Cells(Wiederholungen, 4)
ElseIf Sheets("Hilfstabelle").Cells(Wiederholungen, 4) "" Then
empfänger = empfänger & "; " & Sheets("Hilfstabelle").Cells(Wiederholungen, 4)
End If
Next
Dim inhalt As String
inhalt = "Link zur Redaktionsliste: file:\\" & ThisWorkbook.Path & "\" & ThisWorkbook.Name
'EMail Versenden
Set olApplication = CreateObject("Outlook.Application")
Set objEmail = olApplication.CreateItem(olMailItem)
Application.Wait Now + TimeSerial(0, 0, 5)
With objEmail
'Empfänger einfügen
.To = empfänger
'Betreff schreiben
.Subject = "Neue Anforderung in der Redaktionsliste"
'Inhalt schreiben (Link zur Liste)
.Body = inhalt
.send
End With
SendKeys "%s", True
SendKeys "^{Enter}", True
Set objEmail = Nothing
End Sub