Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
424to428
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
424to428
424to428
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Erster Wert oberhalb einer leeren Zelle
Glen
Hallo Excelfreunde
Ich habe folgendes Makro, dass einen Termin in Outlook erstellt. Es funktioniert soweit auch einwanfrei. Der Termin wird +10 Tage vom Datum, dass in B1 steht geöffnet. Wie kann ich erreichen, dass immer das letzte Datum, dass in Spalte B eingetragen (egal ob B1, B2, B3 usw....) wird, vom Makro berücksichtigt wird?
Besten Dank vorab für eure Hilfe
Grüsse
Glen

Sub Excel_Control_Termin_nach_Outlook()
Dim OutApp As Object, apptOutApp As Object
Dim PW As String
PW = InputBox("Die Aufgabenstellung ist nur von Personen zu tätigen," & vbCr & _
"die dafür die Berechtignung besitzen." & vbCr & "                                                                                                                        Bitte Passwort angeben", "Passwortabfrage", "")
If PW <> "1" Then
MsgBox "Sie haben das falsche Passwort eingegeben", vbExclamation, "Passwortfehler"
Exit Sub
End If
MsgBox "Sie können im Anschluss den Termin noch" & vbCr & "anderen Mitarbeitern zustellen.", vbInformation, "Weitere daran erinnern"
Dim i
Dim ArtNr, ZeileNr As String
ArtNr = Cells(Range("A65536").End(xlUp).Row, 1).Value
ZeileNr = Range("A65536").End(xlUp).Row
Set OutApp = CreateObject("Outlook.Application")
'Hier beginnen die Termine
Range("B1").Select
Do Until ActiveCell.Value = ""
Set apptOutApp = OutApp.CreateItem(1) 'olAppointmentItem)
With apptOutApp
'Termininfo
.Subject = "Dokument: " & ActiveWorkbook.Name & " bearbeiten"
'Zusätzlicher Text
.Body = "Die 10 Tagefrist zum Artikel " & ArtNr & " in der Zeile " & ZeileNr & " ist abgelaufen"
'ort
.Location = "VSB-Büro"
'Uhrzeit
.Start = Format(Date + (10), "dd.mm.yyyy") & " 08:00"
'Dauer. Angabe ist jeweils in ganzen Minuten zu setzen
.Duration = "10"
'Erinnerung
.ReminderMinutesBeforeStart = 10
'mit Sound :-)
.ReminderPlaySound = True
'Erinnerung wiederholen
.ReminderSet = True
'Termin speichern
.Save
.Recipients.Add ("SPNCOBARBIER")
.Recipients.Add ("SPNEFKELLER")
.Recipients.Resolveall
.Display
End With
'Nächste Zelle auswählen
ActiveCell.Offset(1, 0).Select
'Variablen leeren,... sonst "kotzt" Outlook irgendwann mal
Set apptOutApp = Nothing
Set OutApp = Nothing
Loop
MsgBox "Bei Ihnen wurde der Termin eingetragen!", vbInformation, "Termineintrag Outlook"
End Sub

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

Betreff
Benutzer
Anzeige
AW: Erster Wert oberhalb einer leeren Zelle
Ramses
Hallo
Lösche die Zeile "Do until....", "ActiveCell.Offset(1,0)" und "Loop".
Änder die Zeile
.Start = Format(Date + (10), "dd.mm.yyyy") & " 08:00"
in
.Start = Format(Cells(65536, 2).End(xlUp).Row, "dd.mm.yyyy") & " 08:00"
Dann sollte es tun.
Gruss Rainer
PS: Man darf ruhig schreiben woher man das hat ;-)
AW: Erster Wert oberhalb einer leeren Zelle
Glen
Hallo Rainer
Ja klar, dass Makro habe ich ab deiner Homepage und es ist genial !
Habe das wie folgt eingebaut und erhalte sofort eine Erinnerung, die da sagt:
Termin seit 5444 Wochen fällig ?

Sub Excel_Control_Termin_nach_Outlook()
Dim OutApp As Object, apptOutApp As Object
Dim PW As String
PW = InputBox("Die Aufgabenstellung ist nur von Personen zu tätigen," & vbCr & _
"die dafür die Berechtignung besitzen." & vbCr & "                                                                                                                        Bitte Passwort angeben", "Passwortabfrage", "")
If PW <> "1" Then
MsgBox "Sie haben das falsche Passwort eingegeben", vbExclamation, "Passwortfehler"
Exit Sub
End If
MsgBox "Sie können im Anschluss den Termin noch" & vbCr & "anderen Mitarbeitern zustellen.", vbInformation, "Weitere daran erinnern"
Dim i
Dim ArtNr, ZeileNr As String
ArtNr = Cells(Range("A65536").End(xlUp).Row, 1).Value
ZeileNr = Range("A65536").End(xlUp).Row
Set OutApp = CreateObject("Outlook.Application")
'Hier beginnen die Termine
Range("B1").Select
ActiveCell.Offset(1, 0) = Value
Set apptOutApp = OutApp.CreateItem(1) 'olAppointmentItem)
With apptOutApp
'Termininfo
.Subject = "Dokument: " & ActiveWorkbook.Name & " bearbeiten"
'Zusätzlicher Text
.Body = "Die 10 Tagefrist zum Artikel " & ArtNr & " in der Zeile " & ZeileNr & " ist abgelaufen"
'ort
.Location = "VSB-Büro"
'Uhrzeit
.Start = Format(Cells(65536, 2).End(xlUp).Row, "dd.mm.yyyy") & " 08:00"
'Dauer. Angabe ist jeweils in ganzen Minuten zu setzen
.Duration = "10"
'Erinnerung
.ReminderMinutesBeforeStart = 10
'mit Sound :-)
.ReminderPlaySound = True
'Erinnerung wiederholen
.ReminderSet = True
'Termin speichern
.Save
.Recipients.Add ("SPNCOBARBIER")
.Recipients.Add ("SPNEFKELLER")
.Recipients.Resolveall
.Display
End With
'Nächste Zelle auswählen
ActiveCell.Offset(1, 0).Select
'Variablen leeren,... sonst "kotzt" Outlook irgendwann mal
Set apptOutApp = Nothing
Set OutApp = Nothing
MsgBox "Bei Ihnen wurde der Termin eingetragen!", vbInformation, "Termineintrag Outlook"
End Sub

Anzeige
Kopierfehler :-))
Ramses
Hallo
Sorry,... hab beim zusammenkopieren was vergessen .-)
.Start = Format(cells(Cells(65536, 2).End(xlUp).Row,2), "dd.mm.yyyy") & " 08:00"
ist die richtige Anweisung
Gruss Rainer
Tausend Dank Rainer !
Glen
Super Sache!
Danke Rainer und Gute Nacht.
Gruss
Glen
Merci :-) Geschlossen. o.T.
Ramses
...
Sorry, es ist etwas verloren gegangen
Glen
Nochmals Hallo
Es tut zwar, aber die Erinnerung kommt nicht zehn Tage später, wie das zu Beginn der Fall war.
Das hatte ich:
.Start = Format(Date + (10), "dd.mm.yyyy") & " 08:00"
Und das jetzt:
.Start = Format(Cells(Cells(65536, 2).End(xlUp).Row, 2), "dd.mm.yyyy ") & " 08:00"
Ich habe es versucht einzubauen, aber komme nicht drauf !
Glen
Anzeige
AW: Sorry, es ist etwas verloren gegangen
Ramses
Hallo
.Start = Format(Cells(Cells(65536, 3).End(xlUp).Row, 3)+ 10, "dd.mm.yyyy ") & " 08:00"
Sollte es sein
Gruss Rainer
Das war's definitiv :-) DANKE !
Glen
Nochmals Danke vielmals Rainer
Gruss
Glen
Merci :-)) Geschlossen o.T.
Ramses
...

309 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige