Projektplan kein Balken sondern Kreuze

[RPP63]

Der Ralf ist auf halbem Weg stehen geblieben.

Na, die andere Hälfte ist ja genauso einfach. ;)
C2 markieren, Ansicht, Fenster fixieren, Fenster fixieren
Dann
Microsoft Excel Objekt DieseArbeitsmappe

Option Explicit 
 
Private Sub Workbook_Open() 
Tabelle2.Activate 'Tabelle anpassen!!! 
ActiveWindow.ScrollColumn = Evaluate("MATCH(TODAY(),1:1)") 
End Sub 

Gruß Ralf

[Helvetier]

Hallo Ralf, ich fürchte, dass Du so einiges übersehen hast!: wenn Du das auch noch berücksichtigst, brauchst Du Zeit und es ist dann nicht mehr ganz soooooo einfach.
Gruss

[Helvetier]

Hallo Nike
Im Anhang eine xlsx - Datei und unten der Code. Den Code bitte einbauen im VBAProject unter Tabelle2. Dann unter xlsm abspeichern.
Zum testen:
- ganze Spalte E markieren > rechte Maustaste > Zellen löschen
- den Cursor in Zelle E1 setzen > ein Makro sollte nun eine Spalte einfügen, datieren und die Kreuze eintragen.
Gruss

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim sngYa As Single
   Dim sngYe As Single
   Dim sngY As Single
   If Target.Address = "$E$1" Then
       If Target < Date Then
           Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
           ActiveCell.ColumnWidth = 2
           DatumZellenformat
           sngYa = 2
           sngYe = ActiveSheet.UsedRange.Rows.Count
           sngY = sngYa
           Do While sngY < sngYe
               If Range("C" & sngY) <= Range("E1") Then
                   If Range("D" & sngY) >= Range("E1") Then
                       Range("E" & sngY) = "x"
                   End If
               End If
               sngY = sngY + 1
           Loop
       End If
   End If
End Sub

Sub DatumZellenformat()
   Range("$E1") = Date
   Range("$E1").NumberFormat = "dd/mm/yy;@"
   With Range("$E1")   'Selection
       '.HorizontalAlignment = xlGeneral
       '.VerticalAlignment = xlBottom
       '.WrapText = False
       .Orientation = 90
       '.AddIndent = False
       '.IndentLevel = 0
       '.ShrinkToFit = False
       '.ReadingOrder = xlContext
       '.MergeCells = False
   End With
   With Range("$E1").Font   '.Select.Font
       .Name = "Arial"
       .FontStyle = "Standard"
       .Size = 8
       '.Strikethrough = False
       '.Superscript = False
       '.Subscript = False
       '.OutlineFont = False
       '.Shadow = False
       '.Underline = xlUnderlineStyleNone
       '.ThemeColor = xlThemeColorLight1
       '.TintAndShade = 0
       '.ThemeFont = xlThemeFontNone
   End With
   With Range("$E1").Borders(xlEdgeLeft)
       .LineStyle = xlContinuous
       '.ColorIndex = 0
       '.TintAndShade = 0
       .Weight = xlThin
   End With
   With Range("$E1").Borders(xlEdgeTop)
       .LineStyle = xlContinuous
       '.ColorIndex = 0
       '.TintAndShade = 0
       .Weight = xlThin
   End With
   With Range("$E1").Borders(xlEdgeBottom)
       .LineStyle = xlContinuous
       '.ColorIndex = 0
       '.TintAndShade = 0
       .Weight = xlThin
   End With
   With Range("$E1").Borders(xlEdgeRight)
       .LineStyle = xlContinuous
       '.ColorIndex = 0
       '.TintAndShade = 0
       .Weight = xlThin
   End With
End Sub