|
Hallo liebe leute,
Ich bin ein VBA Anfänger und brauche eure Unterstützung.
Ich möchte dass, wenn in der Zelle N34 "Perfekt :o)" steht, eine msgbox angezeigt wird wo die vorgegebene laufleistung und die erreichte Laufleistung angezeigt werden und von Mitarbeiter per "ok" bestätigt werden,....also nur eine "ok" Möglichkeit in der box,....und wenn in N34 was anderes außer "Perfekt :o)" steht soll eine msgbox kommen wo der Mitarbeiter einen Grund für die nicht-Erreichung der Vorgabe zwingend eingeben muss, wenn kein Kommentar eingegeben wurde soll eine Aufforderungsbox kommen und durc "ok" gelangt der Mitarbeiter wieder in die kommentarbox zurück, wenn Kommentar eingegeben worden ist dann soll nur die normale msgbox kommen, mit angaben über AuftragsID, Soll und Ist Werte!!Hoffe Ihr könnt mir dabei helfen. :)
Ich scheitere glaube ich in diesem Teil von Makro,.......:
End If
MsgBox "Grund für nicht erreichung der Vorgabe eingeben!!" & comment
Loop Until comment <> ""
commentstr = CStr(comment)
End If
Danke im Voraus!!
Nachstehend das Makro das ich benutzen möchte,......
Option Explicit
Const SAVE_PATH = "R:\Austausch\EXP_SH\Leistungskatalog BuBi\Ablage"
Const EMAIL_TO = "d.krstic@np-druck.at"
' Const EMAIL_TO = "d.krstic@np-druck.at"
Const FAKE_MAIL = False
Const PERFEKT_UPPER = "PERFEKT :O)"
Sub Excel_Sheet_via_Outlook_Senden()
Dim MyMessage As Object, MyOutApp As Object
Dim SavePath As String
Dim AWS As String
SavePath = "R:\Austausch\EXP_SH\Leistungskatalog BuBi\Ablage"
ActiveSheet.Copy
ActiveWorkbook.SaveAs SavePath & "\" & Range("$H$27") & "__" & "__" & ActiveSheet.Name & "__" & "__" & Format(Now, "dd_mm_yyyy_hh_mm") & ".xls"
With ActiveWorkbook
AWS = .FullName
.Close
End With
Dim commentstr As String
Dim comment As Variant
If UCase(Range("$N$34").Value) <> PERFEKT_UPPER Then
Do
comment = GetComment()
If comment = False Then
MsgBox "Sie haben die Vorgabe nicht erreicht und haben keinen Grund eingegeben!!" & vbCrLf & "Damit Ihre erreichte Lauf-Leistung an die Abteilungsleitung versendet wird, bitte nochmals die Taste ENTER und DRUCK bestätigen und nach Aufforderung den Grund eingeben!!!"
Exit Sub
End If
MsgBox "Grund für nicht erreichung der Vorgabe eingeben!!" & comment
Loop Until comment <> ""
commentstr = CStr(comment)
End If
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = "d.krstic@np-druck.at"
.Subject = "Vorgabe SH3 " & Range("$H$27")
.Attachments.Add AWS
.Body = "Meine Leistungsdaten!!!" & vbTab & "Bitte prüfen!!" & vbCrLf & Range("$E$2138") & " " & "=" & " " & Range("$J$2138") & vbCrLf & Range("$E$2140") & vbTab & " " & "=" & vbTab & Range("$J$2140") & vbCrLf & Range("$E$2142") & " " & "=" & " " & Range("$J$2142") & vbCrLf & Range("$H$27") & vbCrLf & Range("$K$30") & vbTab & Range("$K$34") & vbCrLf & Range("$K$31") & vbTab & " " & Range("$M$34") & vbCrLf & Range("$N$34")
.Send
Kill AWS
MsgBox "Leistungsblatt wurde erfolgreich an die Abteilungsleitung versendet!!" & Chr(13) & Range("$K$30") & vbTab & Range("$K$34") & Chr(13) & Range("$K$31") & vbTab & vbTab & Range("$M$34") & Chr(13) & Range("$N$34") & Chr(13) & "Mit OK bitte bestätigen!!" & Chr(13) & "Danke!! :o)"
End With
ActiveWorkbook.Save
End Sub
Private Function GetComment() As Variant
GetComment = Application.InputBox(prompt:="Sie haben die Vorgabe-Leistung nicht erreicht" & vbCrLf & vbCrLf & "Bitte einen Grund eingeben", _
Title:="Grund für Nicht-Erreichung der Vorgabe", Type:=2)
End Function
|