Servus Lighty

meine Bauzeitpläne vervollständigen sich zwar dynamisch auf Eingabe der Daten aber das VBA-Modul für die Balkenbeschriftung habe ich mal kurz an deine Tabelle angepasst.

Bei der Unmenge deiner Formeln und Validierungen selbstplaudernd ohne Gewähr!

'******************************************************************************
' module: mdl_schedul / gen. 2014-03-08 07:00:35
'------------------------------------------------------------------------------
' goal
'
'******************************************************************************
'
Option Explicit
'
Dim ows As Excel.Worksheet
Dim osh As Excel.Shape
Dim dStart
'
Sub TestIt()
'
'******************************************************************************
' Name : TestIt / 2015-04-11 07:39:30 / Sub
'------------------------------------------------------------------------------
'
' die Const STARTADRESSE ggf. anpassen (ab Tätigkeit abwärts)
' die Const STARTDATUM ggf. anpassen (Beginn Kalendarium)
'
Const STARTADRESSE As String = "$O$16"
Const STARTDATUM As String = "$C$3"
'
Const m_ModName As String = "mdl_schedul"
Const m_PrcName As String = "TestIt"
Dim m_SendKey As String: m_SendKey = Chr(123) & "F8" & Chr(125)
'
'******************************************************************************
'
Dim c As Excel.Range
'
   On Error GoTo TestIt_Error
'
   Set ows = ThisWorkbook.ActiveSheet
      ClAll                               'delete subset
   With ows
      dStart = .Range(STARTDATUM).Value
      For Each c In _
         Range(.Range(STARTADRESSE).Offset(1), _
         .Cells(.Rows.Count, .Range(STARTADRESSE).Column).End(xlUp))
         '
         If IsDate(c.Offset(, -6)) And VarType(c.Value) = 8 Then _
            ChkIt c
      Next c
   End With
'
   On Error GoTo 0
'
TestIt_Error:
'------------------------------------------------------------------------------
Select Case Err.Number
  Case Is = 0: 'errorless
  ' Case is = #: 'custom
  Case Else: 'display
      Select Case MsgBox(Format(Err.Number, "   #0") & "/" & Err.Description & _
         Chr(13) & Chr(13) & "   goto debuger ?", _
         vbYesNo Or vbCritical Or vbDefaultButton1, _
         m_ModName & " / " & m_PrcName)
      Case vbYes
         Application.SendKeys Keys:=m_SendKey & m_SendKey, Wait:=False
         Stop: Resume
      Case vbNo
         ' Abbruch
   End Select
End Select
'------------------------------------------------------------------------------
Set ows = Nothing
Set osh = Nothing
End Sub
'
Private Sub MakeIt(sRng As Range, qRng As Range)
   Set osh = ows.Shapes.AddShape(msoShapeRectangle, sRng.Left, sRng.Top, sRng.Width, sRng.Height)
   With osh
      .Line.Visible = msoFalse
      .Fill.Visible = msoFalse
      With .TextFrame
         With .Characters
            .Text = qRng.Value
            With .Font
               .Bold = qRng.Font.Bold
               .Size = qRng.Font.Size
          End With
         End With
         .MarginTop = 0
         .HorizontalAlignment = xlHAlignCenter
      End With
   End With
End Sub
'
Private Sub ChkIt(Rng As Range)
Dim Rw As Range
Dim c As Range
Dim dDiff
'
   dDiff = Rng.Offset(, -7).Value - dStart
   Set c = Rng.Offset(, dDiff + 1)
   dDiff = Rng.Offset(, -6).Value - Rng.Offset(, -7).Value
   Set Rw = Range(c, c.Offset(, dDiff))
   MakeIt Rw, Rng
'
End Sub
'
Private Sub ClAll()
   For Each osh In ows.Shapes
      If osh.Type = msoAutoShape And osh.Line.Visible = msoFalse Then osh.Delete
   Next osh
End Sub