automatische Zeilenmarkierung

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub markieren() Dim week_start As Byte Dim week_end As Byte Dim markierung As Byte Dim projekt As Integer For projekt = 5 To 7 'in den zeilen 5 bis 7 stehen deine projekte, ggf anpassen week_start = dt_Kalenderwoche(Range("a" & projekt).Value) week_end = dt_Kalenderwoche(Range("b" & projekt).Value) For markierung = week_start To week_end Cells(projekt, markierung + 3).Interior.Color = vbRed Next markierung Next projekt End Sub Function dt_Kalenderwoche(dat As Date) As Integer Dim a As Integer a = Int((dat - DateSerial(Year(dat), 1, 1) + _ ((Weekday(DateSerial(Year(dat), 1, 1)) + 1) Mod 7) - 3) / 7) + 1 If a = 0 Then a = dt_Kalenderwoche(DateSerial(Year(dat) - 1, 12, 31)) ElseIf a = 53 And (Weekday(DateSerial(Year(dat), 12, 31)) - 1) Mod 7

Private Sub Workbook_Open() Call aktuelle_kw_färben End Sub Function aktuelle_kw_färben() Dim datum As Date Dim aktuelle_kw As Byte datum = Now() aktuelle_kw = dt_Kalenderwoche(datum) Range("A:BC").Interior.Color = vbWhite Call markieren Columns(1 + aktuelle_kw).Interior.Color = vbYellow End Function

Hallo Rainer,
vielen Dank erstmal für Deine Rückmeldung!
einen Bug habe ich noch gefunden... Die aktuelle KW färbt er nicht richtig ein. Jetzt z.B. 11 obwohl wir in der 13 sind..
Ist es möglich, dass er die aktuelle KW nicht bis ganz nach unten färbt, sondern, dass ich festlege bis wohin. Z.B. Zeile 81
Und angenommen, ich füge jetzt vorne noch 2 Spalten ein. Wie stelle ich da sicher, dass dann immer noch die richtige KW eingefärbt wird?!
ich hatte schonmal eine Datei mit aktueller KW einfärben. Damals hatte ich folgendes Script verwendet.
Nur das funktioniert jetzt nicht, da das alles überschrieben wird.

 Private Sub Workbook_Open()
MakeWhite
MakeGrey
DINKw (Date)
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Sh.Range("B4").Value = Date
Application.EnableEvents = True
End Sub
Function MakeWhite()
For i = 8 To 60
Dim val As Integer
val = i
Range(ColLtr(val) & 7).Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlSolid
End With
Next i
End Function
Function MakeGrey()
Range("I8:BH71").Interior.ColorIndex = 15
End Function
Function DINKw(Datum As Date) As Integer
Dim lngT As Long
Dim KW As Integer
lngT = DateSerial(Year(Datum + (8 - Weekday(Datum)) Mod 7 - 3), 1, 1)
KW = ((Datum - lngT - 3 + (Weekday(lngT) + 1) Mod 7)) \ 7 + 1
For i = 7 To 71
Range(ColLtr(KW + 8) & i).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Next i
End Function
Function ColLtr(iCol As Integer) As String
If iCol > 0 And iCol

Vielen Dank und noch schöne Ostern!

For projekt = 5 To 13 'in den zeilen stehen die projekte, ggf anpassen If projekt = 5 Or projekt = 6 Or projekt = 8 Or projekt = 10 Or projekt = 13 Then ' dann der bisherige code End If Next projekt

Beliebteste Forumthreads (12 Monate)

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread