Ok.
Des is mein code der in der tabelle steht:
Option Explicit'## Zwischenspeichern der aktuellen Zelle (im Changeereignis sind die Werte der neuen Zelle bei Activecell zu finden)
'## es werden aber die Werte der geänderten Zelle benötigt.
'## Dafür werden diesen beiden Variablen im SelectionChange-Ereignis die Werte der aktuellen Zelle zugewiesen.
'## Dieses Ereignis wird nach dem Change-Ereignis aufgerufen -> diese Variablen haben noch den Wert der
'## geänderten Zelle und ermöglichen die Auswertung einer Änderung.
Private aktuelle_zeile As Long
Private aktuelle_spalte As Long
'## damit das Schreiben per Code keine Ereignisse auslöst
Private zuordnung_per_code As Boolean
'## Zuweisen eines Wertes an Variablen beim Laden der Tabelle
Private Sub Worksheet_Activate()
aktuelle_zeile = 1
aktuelle_spalte = 1
ActiveCell.Columns = 1
ActiveCell.Rows = 1
zuordnung_per_code = False
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim startzeit As Variant
'## Diese Variable wird abgefragt, damit das Schreiben in das Sollendefeld nicht von dieser Prozedur
'## ausgewertet wird. Ansonsten würde ein mehrfacher Prozeduraufruf stattfinden.
If zuordnung_per_code = False Then
'## welche Spalte wurde geändert
Select Case aktuelle_spalte
'Case 2
'## Von wem erfasst?
'startzeit = Sheets("Tabelle1").Cells(aktuelle_zeile, 3)
'## falls noch keine Startzeit eingegeben wurde, wird die momentane Zeit
'## in das Startzeitfeld geschrieben.
'If (IsNull(startzeit) = True) Or (startzeit = "") Then
' zuordnung_per_code = True
' Sheets("Tabelle1").Cells(aktuelle_zeile, 3) = Now
' zuordnung_per_code = False
'End If
Case 10
'## 'Ist Zeit' wurde geändert (Target enthält den Wert der geänderten Zelle)
Call Zeit_berechnen(Target)
End Select
End If
'If Target.Column = 2 Then
'Call AktuellesDatum
'End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'## Zuweisen der aktuell gewählten Zelle an die Variablen
aktuelle_zeile = ActiveCell.row
aktuelle_spalte = ActiveCell.Column
End Sub
'## Endzeit wird der Prozedur übergeben entspricht dem Wert der geänderten 'IST-Zeit behoben' -Zelle
Private Sub Zeit_berechnen(endzeit As Variant)
Dim startzeit As Variant
Dim Prioritaet As Variant
Dim Sollende As Variant
Dim wert1 As Variant
Dim wert2 As Variant
Dim wert3 As Variant
On Error Resume Next
wert1 = Sheets("Tabelle3").Range("B2")
wert2 = Sheets("Tabelle3").Range("B3")
wert3 = Sheets("Tabelle3").Range("B4")
' '## Ist ein Datum eingetragen ?
If IsDate((endzeit)) = False Then
MsgBox ("Bitte tragen Sie eine Zeit-Datumskombination in das Feld 'IST-Zeit behoben' ein.")
Exit Sub
Else
' '## Hat der User auch eine Zeit eingetragen ?
If Hour(endzeit) = 0 Then
MsgBox ("Bitte geben Sie die Fertigstellungszeit an.")
Exit Sub
End If
End If
'## Auslesen der zugehörigen Priorität
Prioritaet = Sheets("Tabelle1").Cells(aktuelle_zeile, 7)
'## Auslesen der zugehörigen Start- bzw. Meldungszeit
startzeit = Sheets("Tabelle1").Cells(aktuelle_zeile, 3)
'## Ist ein Datum eingetragen ?
'If IsDate((startzeit)) = False Then
' MsgBox ("Bitte tragen Sie eine Zeit-Datumskombination in das Feld 'Datum / Zeit' ein.")
' Exit Sub
'Else
' '## Hat der User auch eine Zeit eingetragen ?
If Hour(startzeit) = 0 Then
MsgBox ("Bitte geben Sie die Meldungszeit an.")
Exit Sub
End If
'End If
'## Ist eine gültiger Prioritätswert angegeben ?
If IsNumeric(Prioritaet) = False Then
MsgBox ("Bitte geben Sie eine Priorität an.")
Exit Sub
Else
If (Prioritaet < 1) Or (Prioritaet > 3) Then
MsgBox ("Bitte geben Sie eine Priorität von 1, 2 oder 3 an.")
Exit Sub
End If
End If
'## Jetzt sind Start- und Endzeit sowie Priorität vorhanden. Vor der Berechnung der Sollzeit
'## erfolgt noch eine Überprüfung, ob der Endzeitpunkt vor dem Startzeitpunkt liegt.
'## Die Minuten zwischen Start und Endzeit werden abgefragt
If DateDiff("n", startzeit, endzeit) < 0 Then
MsgBox ("Der Fertigstellungszeitpunkt darf nicht vor dem Meldungszeitpunkt liegen.")
Exit Sub
End If
'## Nachdem dies auch zur Zufriedenheit geklärt wurde, wird die Sollendzeit berechnet.
'## Zuerst wird noch geprüft, ob die Meldung nach dem Feierabend erfolgte,
'## wenn ja wird der Startzeitpunkt für die Berechnung auf 08:00 des nächsten Tages (bei
'## Meldung vor 24:00 Uhr ansonsten auf 08:00 Uhr des entsprechenden Tages gelegt.
If (Hour(startzeit) > 16) Then
'## Meldung nach oder um 17:00
startzeit = Day(startzeit) & "." & Month(startzeit) & "." & Year(startzeit) & " " & "08:00:00"
startzeit = DateAdd("d", 1, startzeit)
ElseIf (Hour(startzeit) < 8) Then
'## Meldung vor 08:00 Uhr
startzeit = Day(startzeit) & "." & Month(startzeit) & "." & Year(startzeit) & " " & "08:00:00"
End If
'## Fällt der Startzeitpunkt auf ein Wochenende wird Montag 08:00 als Startzeitpunkt genommen
Select Case Weekday(startzeit)
Case 1
'## Sonntag
startzeit = Day(startzeit) & "." & Month(startzeit) & "." & Year(startzeit) & " " & "08:00:00"
startzeit = DateAdd("d", 1, startzeit)
Case 7
'## Sonnabend
startzeit = Day(startzeit) & "." & Month(startzeit) & "." & Year(startzeit) & " " & "08:00:00"
startzeit = DateAdd("d", 2, startzeit)
End Select
'## je nach Priorität wird das Sollende berechnet
Select Case Prioritaet
Case 1
'## 2 Stunden
Sollende = DateAdd("h", wert1, startzeit)
Case 2
'## 6 Stunden
Sollende = DateAdd("h", wert2, startzeit)
Case 3
'## 1 Tag
Sollende = DateAdd("h", wert3, startzeit)
Case Else
MsgBox ("Bitte geben Sie eine Priorität von 1, 2 oder 3 an.")
Exit Sub
End Select
'## Bisher ist das Sollende für einen 24 Stundenarbeitstag ohne Berücksichtigung des Wochenendes erstellt.
'## Überprüfung, ob Sollende nach Feierabend liegt, da maximal eine Stundenzahl von 6 (max. 23:00 Uhr)addiert wird
'## reicht eine Prüfung daraufhin, ob das Sollende nach 17:00 Uhr liegt.
If Hour(Sollende) > 17 Then
'## Sollende liegt nach Feierabend -> es werden 15 Stunden (Zeit vom Feierabend bis zum Arbeitsbeginn)
'## zum Sollende addiert.
Sollende = DateAdd("h", 15, Sollende)
End If
'## Fällt das Sollende auf einen Wochenendtag ? Wenn ja wird das Sollende auf Montag verlegt.
Select Case Weekday(Sollende)
Case 1
'## Sonntag
Sollende = DateAdd("d", 1, Sollende)
Case 7
'## Sonnabend
Sollende = DateAdd("d", 2, Sollende)
End Select
'## damit im Changeereignis die Auswertung nicht erfolgt, wird die Variable auf true gesetzt
zuordnung_per_code = True
'## Schreiben des Sollendes in das entsprechende Feld
Sheets("Tabelle1").Cells(aktuelle_zeile, 9) = Sollende
'## liegt das Sollende vor dem Istende
If DateDiff("s", Sollende, endzeit) > 0 Then
'Werte werden rot markiert, wenn Sollende vor dem Istende liegt
Sheets("Tabelle1").Cells(aktuelle_zeile, 9).Font.Color = RGB(255, 0, 0)
Else
'Werte sind in Tabelle1 werden schwarz markiert, wenn Sollende nach dem Istende liegt
Sheets("Tabelle1").Cells(aktuelle_zeile, 9).Font.Color = RGB(0, 0, 0)
End If
'## Zurücksetzen der Variable
zuordnung_per_code = False
End Sub
Und des is mein code im modul:
Option Explicit
Sub AktuellesDatum()
'
' AktuellesDatum Makro
' Makro am 30.09.2002 von MATERNPA aufgezeichnet und von Bojeoliv bearbeitet
'
' Tastenkombination: Strg+d
Dim DateNow As Date
Dim zeile As Integer
Dim spalte As Integer 'braucht man eigentlich nicht....
DateNow = Now()
ActiveCell.Value = DateNow
zeile = ActiveCell.row
spalte = ActiveCell.Column
'Kontrollausgabe!
'MsgBox "Datum befindet sich in " & vbCrLf & "Zeile: " & zeile & vbCrLf & "Spalte: " & spalte
Cells(zeile, "A").Value = zeile - 1
Cells(zeile, "F").Value = "nein"
Cells(zeile, "G").Value = "3"
End Sub
Und jez will ich dass er die sollzeit (sollende einträgt wenn ich strg und d drücke so wie nein und prio. geht des ? verstehste es?