Opgelost Projectplan houd geen rekening met werkdagen als offset wordt toegevoegd

[KeBr]

Beste,

Ik heb een projectplan dat grotendeels al goed werkt. Nu is het zo dat ik in kolom "D" een offset heb toegevoegd.
De geplaatste Shapes gaan echter dan niet zover mee als er een weekend tussen zit. de waarde van kolom "D" wordt wel bij de waarde van kolom "E" opgeteld.

Ik heb er ook een stukje voorwaardelijk opmaak inzitten om de afwijkingen te markeren, dat werkt wel goed.

het gaat om het deel van de onderstaande macro:

Next
    'get equal date  cells
   LftCell = Cells(r, 5) + Cells(r, 4) - Cells(6, 5) + 11
   RtCell = Cells(r, 6) - Cells(6, 5) + 11
  
      
  x = Application.Match(Cells(r, 3), Sheets("Gegevens").Columns(5), 0)
  If IsNumeric(x) Then fc = RGB(Sheets("Gegevens").Cells(x, 6), Sheets("Gegevens").Cells(x, 7), Sheets("Gegevens").Cells(x, 8))

Select Case Cells(r, 7).Value
 
Case Is <= 0
    'diamond for Milestone date
    Set NewShp = ActiveSheet.Shapes.AddShape(msoShapeDiamond, Cells(r, LftCell).Left, Cells(r, LftCell).Top + 2, Cells(r, LftCell).Width, Cells(r, LftCell).Height - 4)
          NewShp.Fill.ForeColor.RGB = fc
            NewShp.Line.ForeColor.RGB = fc
          
Case Else

'Get date ranges
    Set DtRng = Range(Cells(r, LftCell), Cells(r, RtCell))
        LftCell = Cells(r, 5) + Cells(r, 4) + 1 - Cells(6, 5) + 8
        RtCell = Cells(r, 6) + 1 - Cells(r, 5) + 12
        
    'if "fase" in C then add a rectangle
    If Cells(r, 3) = "fase" Or Cells(r, 3) = "project" Then
    Set NewShp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, DtRng.Left + 1, DtRng.Top + 2, DtRng.Width - 10, DtRng.Height - 10)
          NewShp.Fill.ForeColor.RGB = fc
            NewShp.Line.ForeColor.RGB = fc 'FormulaLocal = "VERT.ZOEKEN(range(C12:C50);Blad3!E3:I28;5;onwaar)"
    Set DtRng = Range(Cells(r, LftCell), Cells(r, RtCell))
        LftCell = Cells(r, 5) + Cells(r, 4) + 1 - Cells(6, 5) + 10
        RtCell = Cells(r, 5) + Cells(r, 4) + 1 - Cells(r, 5) + 12
    Set NewShp = ActiveSheet.Shapes.AddShape(msoShapeFlowchartMerge, Cells(r, LftCell).Left + 1, Cells(r, LftCell).Top + 2, Cells(r, LftCell).Width - 5, Cells(r, LftCell).Height - 4)
           NewShp.Fill.ForeColor.RGB = fc
            NewShp.Line.ForeColor.RGB = fc
    Set DtRng = Range(Cells(r, LftCell), Cells(r, RtCell))
        LftCell = Cells(r, 6) - Cells(6, 5) + 11
        RtCell = Cells(r, 5) + Cells(r, 4) + 1 - Cells(r, 5) + 12
    Set NewShp = ActiveSheet.Shapes.AddShape(msoShapeFlowchartMerge, Cells(r, LftCell).Left + 4, Cells(r, LftCell).Top + 2, Cells(r, LftCell).Width - 5, Cells(r, LftCell).Height - 4)
           NewShp.Fill.ForeColor.RGB = fc
            NewShp.Line.ForeColor.RGB = fc