Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1356to1360
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Meldung einer momentanen Bearbeitung

Meldung einer momentanen Bearbeitung
25.04.2014 11:42:44
Kazo
Hallo Leute, ich habe vorhin eine Hilfestellung für das automatisches Senden einer Email nach ausfüllen einer Maske erhalten. Jedoch ist noch die letzte Bitte: Wenn die Maske ausgefüllt wird und auf Erstellen gegangen wird und nun eine automatische email versendet wird dauert es eine weile so 5-7 sekunden und die maske verschwindet erst dann! Ich möchte das während dieser Warte zeit von paar sekunden eine Meldung erscheint in der steht "Bearbeitung wird gespeichert, bitte warten!" oder so in der art! Hier ist der Code:
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 wurde
Sub 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

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Meldung einer momentanen Bearbeitung
25.04.2014 12:29:18
Rudi
Hallo,
dauert es eine weile so 5-7 sekunden
du hast ja auch 5 Sek. Wartezeit eingebaut.
und die maske verschwindet erst dann!
dann dreh die beiden Befehle um:
        mail
UserformSchließen (True)

Gruß
Rudi

AW: Meldung einer momentanen Bearbeitung
25.04.2014 12:44:49
Kazo
Danke dir Rudi es funktioniert! mich würde es bloß interessieren ob so etwas überhaupt möglich ist, dass eine Meldung während der Wartezeit möglich ist!?
Gruß Kazo

AW: Meldung einer momentanen Bearbeitung
25.04.2014 12:49:03
Rudi
Hallo,
z.B. per Statusbar:
Application.Statusbar="Mailversand"
Mail
Application.Statusbar=False
Gruß
Rudi

Anzeige
AW: Meldung einer momentanen Bearbeitung
25.04.2014 13:16:31
Kazo
Danke dir Rudi! Wünsche dir ein schönes Wochenende.
Gruß

hatten wir darüber nicht schon gesprochen, Kazo?
25.04.2014 13:35:00
Klaus
Hi Kazo,
sowas:
Sheets("Anforderungen").Unprotect Password:="39wPqg2h"
gehört aber aus Prinzip nicht hochgeladen, dafür hatte ich dich schon das letzte mal gerügt!
Grüße,
Klaus M.vdT.

AW: hatten wir darüber nicht schon gesprochen, Kazo?
25.04.2014 13:46:28
Kazo
Hallo Klaus, das stimmt da hast du mir schon letztens den Tipp gegeben. ich habs vergessen bzw. nicht mehr dran gedacht. Danke für die Info. In Zukunft werde ich da besser aufpassen
Gruß Kazo

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige