Hallo Forumler,

ich habe folgendes Problem. Ich habe einen Projektplan mit Prozessen und Meilensteinen. Die Tabelle ist folgendermaßen aufgebaut:

A             B            C                D          E         

Rolle      Farbe    Vorgang    Start    Ende

Anhand der Start-/Ende-Daten lasse ich die Prozesse/Vorgänge bereits in einem GANTT-Diagramm zeichnen (Kein Diagramm - es werden Zellen eingefärbt!). Das funktioniert auch soweit.

Jetzt fehlen noch die Meilensteine, die darüber definiert werden, wenn Start/Ende gleich sind. Es soll dann am Ende-Datum ein Dreieck in genau der Zelle eingefügt werden, die durch eine Funktion ermittelt wird. Zusätzlich soll der Meilenstein die Farbe aus Spalte B bekommen (der Rand ist Nebensache).

Anbei der Code für die Prozesse und das GANTT:

Sub Schaltfläche2_Klicken()


Dim i As Integer, j As Integer, k As Integer
Dim intRow As Integer
Dim kw As Integer
Dim S As Date
Dim E As Date
Dim jahr As Integer
Dim dauer As Integer
Dim Milestone As Shape


Range(Cells(5, 13), Cells(91, 600)).Interior.ColorIndex = 0

For i = 5 To 326                    'Zaehler fuer die Vorgaenge
kw = 0                                    'Setze kw=0
    S = Cells(i, 4)                   'Start steht in Spalte D
    jahr = Year(S)                  'Jahr = Jahr aus Spalte D
    E = Cells(i, 5)                   'Ende steht in Spalte E
   dauer = (E - S) / 7             'Dauer = Enddatum - Startdatum /7 --> führt zu Anzahl Zellen (KW-Bloecken) zum einfaerben
   

   
 For j = 14 To 670                                                                                 'Zaehler für die Kalenderwochen im GANTT
      If Cells(327, j) = DINKw(S) And Cells(330, j) = jahr Then                                     'Wenn KW (Zeile 327) = der Funktion unten UND das Jahr (Zeile 330) = das Startjahr aus Spalte D,
         kw = j                                                                                                'dann setzte kw = der Spalte und
        Range(Cells(i, kw), Cells(i, kw + dauer)).Interior.Color = Cells(i, 2).Interior.Color       'faerbe die Zellen im GANTT mit der jeweiligen Zellenfarbe aus Spalte B ein
    End If
  Next j
  
    
Next i                              'naechster Vorgang

Cells(1, 1).Select

End Sub

Function DINKw(Datum As Date) As Integer                                    'Liefert die jeweilige KW zum eingegebenen Datum ein
Dim lngT As Long
   lngT = DateSerial(Year(Datum + (8 - Weekday(Datum)) Mod 7 - 3), 1, 1)
   DINKw = ((Datum - lngT - 3 + (Weekday(lngT) + 1) Mod 7)) \ 7 + 1
End Function

Die Frage ist nun, wie kriege ich die Meilensteine-Codierung in die Forschleife mit hinein und wie sieht diese dabei aus? Ich denke bereits an eine weitere For-Schleife mit "If S = E Then ActiveSheet.Shapes.AddShape" oder sowas. Habe auch bereits mit dem Rekorder experimentiert, kann aber nicht definieren, dass das Dreieck in eine bestimmte Zelle eingefügt werden soll...

Ich danke für eure Mithilfe.

Grüße,

Heiko