Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Excel2010 - Hilfe beim Umschreiben eines Makros

Betrifft: Excel2010 - Hilfe beim Umschreiben eines Makros von: Andreas
Geschrieben am: 28.08.2014 08:25:45

Hallo zusammen,

hoffe, dass mir hier geholfen werden kann.
Habe mir im Netz nen geniales Makro gezogen.
Jetzt würde ich gerne dieses umschreiben, leider fehlen diesbezüglich die notwendigen Kennntisse.

Anbei natürlich das Makro. Hier wird eine Outlook- Aufgabe aus Excel erstellt.
Dieses Makro soll aus Excel2010 über ein button ausgelöst werden.
Anstatt nach einer der Dauer von 20Tagen zu fragen, soll ein Datum aus einer Zelle übernommen werden. Standard mäßig soll immer ein Tag vorher ein Erinnerung erscheinen. Könnt ihr mir hierbei helfen?

Zweite Frage: Wenn ich diese Excel datei öffne(doppelklick) und makro ausführe, funktioniert das einwandrfrei. Wenn ich aber diese Datei mit nem Hyperlink aus ner anderen Datei öffne und das Makro ausführe, meckert er!(Datei wurde nicht gespeichert) Würde gerne dieses Gimmick gerne behalten!

Gruß Hauenkrieger

Sub Excel_an_Outlook_Aufgabe()
'Dieses Code-Beispiel sollte ab Outlook XP sicher funktionieren
'O 2000 und O97 wurden nicht getestet
'Einschaltung der Fehlerbehandlung
On Error GoTo ErrorToDo
'Verwendete Variablen
Dim myToDo As Date, myDay As String, myRemBefore As Integer, myToInterVal
Dim Qe As Integer
Dim myLink As String
Dim T1 As String, T2 As String, T3 As String, T4 As String
Dim MyOlApp As Object, myJob As Object
'In diesem Beispiel soll der Link auf die aktuelle Datei aufgenommen werden
'um den Inhalt zum gewählten Termin nochmal nachbearbeiten zu können.
'Der Link kann direkt in der Aufgabe angeklickt werden
'Dateiname aufnehmen für einen späteren Link
myLink = ActiveWorkbook.FullName
'Ist kein Doppelpunkt vorhanden in "Fullname" wurde die Datei
'noch nicht gespeichert, daher wird die weitere Verarbeitung
'des Makros abgebrochen.
If Mid(myLink, 2, 1) <> ":" Then
MsgBox "Die Datei wurde noch nicht gespeichert"
Exit Sub
End If
'Aufgabe erstellen heute in X Tagen
'Erzwingen eines korrekten Wertes
Do
myDay = InputBox("Wann soll der Auftrag fertig sein?", "Neue Aufgabe", 20)
Loop While Not IsNumeric(CInt(myDay)) Or CInt(myDay) <= 0
'Abbrechen wurde gewählt
If myDay = "" Then Exit Sub
'Aufgabetermin berechnen, dazu wird die "Texteingabe" aus der Inputbox
'durch die Typumwandlung in eine "Integerzahl" umgewandelt,
'mit der das zukünftige Datum berechnet werden kann.
'aus dem Datum heraus
myToDo = Date + CInt(myDay)
'----
'Alternativ die Eingabe eines Datums erzwingen
'Hier wird die Datumseingabe explicit angefordert
'Do
' myToDo = DateValue(InputBox("In wieviel Tagen soll die Aufgabe erstellt werden ?", "Neue  _
Aufgabe", Format(Now + 21, "dd.mm.yyyy")))
'Loop While Not IsDate(myToDo) Or myToDo < Now Or IsEmpty(myToDo)
'If IsEmpty(myToDo) Then Exit Sub
'Alternative Ende
'----
Select Case Weekday(myToDo, 2)
'Würde berechnete Termin auf ein Wochenende fallen
'so soll dies korrigiert werden
Case Is > 5
T1 = "Die Aufgabe würde auf ein Wochenende fallen: " & Format(myToDo, "DDDD DD.MMM.YY")
T2 = "JA = Die Aufgabe wird auf den darauffolgenden Montag verschoben"
T3 = "NEIN = Die Aufgabe auf den Freitag davor verlegt"
T4 = "ABBRECHEN = Die Aufgabe wird am berechneten Termin eingefügt"
Qe = MsgBox(T1 & Chr$(13) & T2 & Chr$(13) & T3 & Chr$(13) & T4, vbYesNoCancel, "Terminkorrektur" _
)
If Qe = vbYes Then
'Termin auf Montag vorverlegen
myToDo = myToDo + (8 - Weekday(myToDo, 2))
ElseIf Qe = vbNo Then
'Termin auf Freitag zurücklegen
myToDo = myToDo - (7 - Weekday(myToDo, 2))
End If
End Select
'Eigentliche Aufgabe erstellen
'Objectvariablen zuweisen
Set MyOlApp = CreateObject("Outlook.Application")
'CreateItem(3) erstellt ein Aufgaben-Object
Set myJob = MyOlApp.CreateItem(3)
With myJob
'Titel der Aufgabe
.Subject = InputBox("Beschreibung der Aufgabe", "Aufgaben Titel", "Datei Nachbearbeiten !")
'Datum wann die Aufgabe erledigt sein muss
.DueDate = myToDo
'Erinnerung in Tagen davor
'In diesem Beispiel wird per default 1 Tag vorher,
'bzw. am Freitag vor einem Montag informiert
'Es werden jedoch max. 30 Tage Vorlaufzeit akzeptiert
Do
myRemBefore = 1
myRemBefore = CInt(InputBox("Wieviel Tage davor:", "Erinnerung max. 30 Tage", myRemBefore))
Loop While Not IsNumeric(myRemBefore) Or myRemBefore > 30
Select Case Weekday(myToDo - myRemBefore, 2)
Case 7
myToDo = myToDo - 2
Case 6
myToDo = myToDo - 1
End Select
'Erinnerung einschalten !!!
.ReminderSet = True
'Für eine Reminder-Uhrzeit muss auch das Datum angegeben
'werden, ansonsten Outlook den 1.1.1900 um 08:00 erinnert :-) !!
'Uhrzeit definieren im Serialformat
'Stunde, Minute, Sekunde
.Remindertime = myToDo & " " & TimeSerial(8, 0, 0)
'Der Einfachheit halber wird das Startdatum auf den gleichen Termin gesetzt
.startDate = myToDo
'Die Wichtigkeit der Aufgabe
'Werte 1,2 und 3 zulässig
.Importance = 2
'Zwecks Optimierung können Sie auch gleich einen Link
'auf ihre Datei erstellen die auf Ihrem Rechner oder Netzwerk liegt
'Wird ein Dateilink mit "\\" erkennt Outlook automatisch dass es ein Link ist
'Bei lokalen Dateien müssen sie den Zusatz "File:" davorsetzen
'um den Link auf die Datei zu erzeugen
'Der Pfad und Dateiname dürfen KEINE Leerzeichen enthalten
'ansonsten wird der Link nicht korrekt dargestellt
.Body = "Diese Datei muss nochmals bearbeitet werden:" & Chr$(13) & _
"\\Server\ShareName\Ordner\" & ActiveWorkbook.Name & Chr$(13) & _
"oder:" & Chr$(13) & "file://" & myLink
'Die Aufgabe wird definitiv gespeichert
.Save
End With
ErrorExit:
Set myJob = Nothing
Set MyOlApp = Nothing
Exit Sub

ErrorToDo:
Select Case Err.Number
Case 13
'Ohne Information aus dem Makro aussteigen
'Der Fehler 13 kommt bei einer Typ-Unverträglichkeit vor
'also z.B. "Abbrechen" in einer Inputbox
Resume ErrorExit
Case Else
'Information an den Benutzer
MsgBox Err.Number & ";" & Err.Description
'Abbruch des Makros
Resume ErrorExit
End Select
End Sub

  

Betrifft: AW: Excel2010 - Hilfe beim Umschreiben eines Makros von: Luschi
Geschrieben am: 28.08.2014 10:45:11

Hallo Andreas,

hier mal die gewünschten Änderungen:

https://www.herber.de/bbs/user/92348.xlsm

Gruß von Luschi
aus klein-Paris


  

Betrifft: AW: Excel2010 - Hilfe beim Umschreiben eines Makros von: Andreas
Geschrieben am: 28.08.2014 11:10:17

Hallo,
danke für die zügigie Antwort.
Aber der Termin soll nicht berechnet werden, sondern über ein Datum in einer bestimmten Zelle übernommen werden. Vllt habe ich mich in meiner Beschreibung auch nicht eindeutig ausgedrückt!


  

Betrifft: AW: Excel2010 - Hilfe beim Umschreiben eines Makros von: Luschi
Geschrieben am: 28.08.2014 15:00:59

Hallo Andreas,

jetzt mal so - in der markierten Zelle steht jetzt ein Datum.

https://www.herber.de/bbs/user/92362.xlsm

Gruß von Luschi
aus klein-Paris


  

Betrifft: AW: Excel2010 - Hilfe beim Umschreiben eines Makros von: Andreas
Geschrieben am: 28.08.2014 15:25:25

Danke für die Hilfe,

aber irgendwie reden wir aneinander vorbei!

Das Makro sollte schon so bleiben wir es ist, nur das Termin nicht durch ein Angabe von Tagen ausgerechnet werden soll, sondern durch ein Datum in einer Betimmten Zelle.

Aber nochmal, Danke für die Hilfe


  

Betrifft: AW: Excel2010 - Hilfe beim Umschreiben eines Makros von: Luschi
Geschrieben am: 28.08.2014 15:33:49

Hallo Andreas,

ich glabe, da ist beim Hochladen was schief gelaufen.
hier noch mal die neue Datei mit dem vorgegebenem Datum

https://www.herber.de/bbs/user/92366.xlsm


Gruß von Luschi
aus klein-Paris


  

Betrifft: AW: Excel2010 - Hilfe beim Umschreiben eines Makros von: Andreas
Geschrieben am: 29.08.2014 07:59:26

Schönen guten MOrgen,
funktioniert prima, danke dafür!

Jetzt habe ich noch zwei Probleme!
1. Das Feld mit dem Datum wird über eine Makro ausgefüllt(aus einer Übersichtsliste)
Sobald ich das Makro ausführe, "Bitte geben Sie ein gültiges Datum in Zelle`$C$8' ein!
Wenn ich das Datum jetzt händisch eintrage, funktionierts wieder! Komisch!

2. Wenn ich diese Datei mittels Hyperlink öffne, und das Makro auführe kommt, Die Datei wurde noch
nicht gespeichert! Wenn ich die Datei über ein doppelklick öffne, funktionierts wieder!

Könntest du mir hierbei nochmal helfen??

Viele Dank im voraus

Gruß
Andreas


  

Betrifft: AW: Excel2010 - Hilfe beim Umschreiben eines Makros von: Luschi
Geschrieben am: 29.08.2014 10:11:57

Hallo Andreas,

zum 1. Problem - das ist immer noch eine typische Kinderkrankheit von Excel. Wenn Du bei 'Google'
nach diesen Stichworten suchst: 'excel vba datum wird nicht erkannt', dann hören die Hilferufe nach 1 Lösung nicht auf.

Schreibe die Werte nach folgendem Muster in die Zellen:
Range("B2").Value = CDate(txtDatum)

Besonders dann, wenn der Datumswert aus einer Textbox vom Formular, InputBox usw. kommt

Vom 2. Problem kann ich mir zur Zeit kein Bild machen, woran das liegen sollte.
Suche mal im Makro diese Zeile: 'myLink = ActiveWorkbook.FullName' und füge davor den Stop-Befehl ein, so das es dann so aussieht:
Stop
myLink = ActiveWorkbook.FullName

Speichere/Beende die Arbeitsmappe und starte den Hyperlink. Jetzt hält das Makro an dieser Stelle an, 'Stop' ist gelb unterlegt und es wurde der Debugger-Modus aktiviert.
Per 'F8'-Taste kann man die nächsten Befehle im Einzelschritt-Modus durchlaufen.
Wurde der Befehl 'myLink = ActiveWorkbook.FullName' ausgeführt und stellt den Mauszeicher auf die Speichervariable 'myLink', wird der Inhalt davon eingeblendet. Man kann aber auch im Direktfenster mit '? myLink' den Wert abfragen.
Mal sehen war da so rauskommt.

Gruß von Luschi
aus klein-Paris


  

Betrifft: AW: Excel2010 - Hilfe beim Umschreiben eines Makros von: Andreas
Geschrieben am: 03.09.2014 12:45:56

Halli Hallo,

dank deiner Hilfe konnte ich nun das Makro fertigstellen!
Funktioniert super, anbei das Makro zur Einsicht!

Jetzt noch eine weitere Frage!
Ich habe eine andere Excel Liste, in der ersten Spalten in der 1.Zeile steht eine 1.
In Zeile 2 eine 2. Ist einfach!!
Jetzt möchte ich beim öffnen der Datei, dass er automatisch in die nächste Zeile eine 3 einträgt!
Geht sowas??


Sub Excel_an_Outlook_Aufgabe()
'Dieses Code-Beispiel sollte ab Outlook XP sicher funktionieren
'O 2000 und O97 wurden nicht getestet
'Einschaltung der Fehlerbehandlung
On Error GoTo ErrorToDo
'Verwendete Variablen
Dim myToDo As Date, myRemBefore As Integer, myToInterVal
Dim myDay As Date
Dim Qe As Integer
Dim myLink As String
Dim T1 As String, T2 As String, T3 As String, T4 As String
Dim MyOlApp As Object, myJob As Object
'In diesem Beispiel soll der Link auf die aktuelle Datei aufgenommen werden
'um den Inhalt zum gewählten Termin nochmal nachbearbeiten zu können.
'Der Link kann direkt in der Aufgabe angeklickt werden
'Dateiname aufnehmen für einen späteren Link
myLink = [Dateiname]
'Ist kein Doppelpunkt vorhanden in "Fullname" wurde die Datei
'noch nicht gespeichert, daher wird die weitere Verarbeitung
'des Makros abgebrochen.
If Mid(myLink, 2, 1) <> ":" Then
MsgBox "Die Datei wurde noch nicht gespeichert"
Exit Sub
End If
'Aufgabe erstellen heute in X Tagen
'Erzwingen eines korrekten Wertes
'Do
'myDay = InputBox("Wann soll der Auftrag fertig sein?", "Neue Aufgabe", 20)
'bisTage ist ein vergebener Name im Mamensmanager (Strg+F3)
'Loop While Not IsNumeric(CInt(myDay)) Or CInt(myDay) <= 0
'Abbrechen wurde gewählt

myDay = [AuftragsTermin].Value
If VarType(myDay) <> vbDate Then
   MsgBox "Bitte gegen Sie ein gültiges Datum in Zelle '" & [AuftragsTermin].Address & "' ein!"
   [AuftragsTermin].Select
   Exit Sub
End If
If myDay < Date Then
   MsgBox "Das Datum liegt leider in der Vergangenheit!", 16, CStr([AuftragsTermin].Value & " !! _
!")
   [AuftragsTermin].Select
   Exit Sub
End If

'Aufgabetermin berechnen, dazu wird die "Texteingabe" aus der Inputbox
'durch die Typumwandlung in eine "Integerzahl" umgewandelt,
'mit der das zukünftige Datum berechnet werden kann.
'aus dem Datum heraus
myToDo = myDay
'----
'Alternativ die Eingabe eines Datums erzwingen
'Hier wird die Datumseingabe explicit angefordert
'Do
' myToDo = DateValue(InputBox("In wieviel Tagen soll die Aufgabe erstellt werden ?", "Neue _
Aufgabe", Format(Now + 21, "dd.mm.yyyy")))
'Loop While Not IsDate(myToDo) Or myToDo < Now Or IsEmpty(myToDo)
'If IsEmpty(myToDo) Then Exit Sub
'Alternative Ende
'----
Select Case Weekday(myToDo, 2)
'Würde berechnete Termin auf ein Wochenende fallen
'so soll dies korrigiert werden
Case Is > 5
T1 = "Die Aufgabe würde auf ein Wochenende fallen: " & Format(myToDo, "DDDD DD.MMM.YY")
T2 = "JA = Die Aufgabe wird auf den darauffolgenden Montag verschoben"
T3 = "NEIN = Die Aufgabe auf den Freitag davor verlegt"
T4 = "ABBRECHEN = Die Aufgabe wird am berechneten Termin eingefügt"
Qe = MsgBox(T1 & Chr$(13) & T2 & Chr$(13) & T3 & Chr$(13) & T4, vbYesNoCancel, "Terminkorrektur" _
)

If Qe = vbYes Then
'Termin auf Montag vorverlegen
myToDo = myToDo + (8 - Weekday(myToDo, 2))
ElseIf Qe = vbNo Then
'Termin auf Freitag zurücklegen
myToDo = myToDo - (7 - Weekday(myToDo, 2))
End If
End Select
'Eigentliche Aufgabe erstellen
'Objectvariablen zuweisen
Set MyOlApp = CreateObject("Outlook.Application")
'CreateItem(3) erstellt ein Aufgaben-Object
Set myJob = MyOlApp.CreateItem(3)
With myJob
'Titel der Aufgabe
.Subject = InputBox("Beschreibung der Aufgabe", "Aufgaben Titel", "Musterauftrag fertig!")
'Datum wann die Aufgabe erledigt sein muss
.DueDate = myToDo
'Erinnerung in Tagen davor
'In diesem Beispiel wird per default 1 Tag vorher,
'bzw. am Freitag vor einem Montag informiert
'Es werden jedoch max. 30 Tage Vorlaufzeit akzeptiert
Do
myRemBefore = 1
'kann entfallen da der Erinnerungstermin auf 1 Tag davor festgelegt wurde
'myRemBefore = CInt(InputBox("Wieviel Tage davor:", "Erinnerung max. 30 Tage", myRemBefore))
Loop While Not IsNumeric(myRemBefore) Or myRemBefore > 30
Select Case Weekday(myToDo - myRemBefore, 2)
Case 7
myToDo = myToDo - 2
Case 6
myToDo = myToDo - 1
End Select
'Erinnerung einschalten !!!
.ReminderSet = True
'Für eine Reminder-Uhrzeit muss auch das Datum angegeben
'werden, ansonsten Outlook den 1.1.1900 um 08:00 erinnert :-) !!
'Uhrzeit definieren im Serialformat
'Stunde, Minute, Sekunde
.Remindertime = myToDo & " " & TimeSerial(6, 0, 0)
'Der Einfachheit halber wird das Startdatum auf den gleichen Termin gesetzt
.StartDate = myToDo
'Die Wichtigkeit der Aufgabe
'Werte 1,2 und 3 zulässig
.Importance = 2
'Zwecks Optimierung können Sie auch gleich einen Link
'auf ihre Datei erstellen die auf Ihrem Rechner oder Netzwerk liegt
'Wird ein Dateilink mit "\\" erkennt Outlook automatisch dass es ein Link ist
'Bei lokalen Dateien müssen sie den Zusatz "File:" davorsetzen
'um den Link auf die Datei zu erzeugen
'Der Pfad und Dateiname dürfen KEINE Leerzeichen enthalten
'ansonsten wird der Link nicht korrekt dargestellt
.Body = "Musterauftrag:" & Chr$(13) & _
""
'Die Aufgabe wird definitiv gespeichert
.Save
End With
ErrorExit:
Set myJob = Nothing
Set MyOlApp = Nothing
Exit Sub

ErrorToDo:
Select Case Err.Number
Case 13
'Ohne Information aus dem Makro aussteigen
'Der Fehler 13 kommt bei einer Typ-Unverträglichkeit vor
'also z.B. "Abbrechen" in einer Inputbox
Resume ErrorExit
Case Else
'Information an den Benutzer
MsgBox Err.Number & ";" & Err.Description
'Abbruch des Makros

Resume ErrorExit
End Select
Set MyOlApp = Nothing
Set myJob = Nothing
End Sub



 

Beiträge aus den Excel-Beispielen zum Thema "Excel2010 - Hilfe beim Umschreiben eines Makros "