Gantt Diagramm Jahresübergreifend

[Helvetier]

Hallo Stelo
Mit etwas Abstand sehe ich 3 weiter zu verfolgende Ansätze für Dein Problem:
1. lupo hebt das um seinen Lösungsansatz errichtete Geheimnis bei Dir auf und Du wendest diesen Ansatz bei Dir an. Die Basis der Zeitachse ist der Tag: 1 Tag = 1 Zelle. Der Kalender wird Tag genau abgebildet.
2. Wir erarbeiten auf der Basis des Ansatzes von lupo eine Lösung mit der Basis der Zeitachse  KW: 1 KW = 1 Zelle (natürlich das Jahr übergreifend). Der Kalender wird nur KW genau abgebildet. Natürlich wirst Du die Mechanik dieser Lösung verstehen. Würde Dir die Basis 1 KW= 1 Zelle genügen?
3. Wir suchen weiter nach einer Lösung auf der Basis Diagramm ... auch unter Einschluss von VBA.
Selber kann ich voraussichtlich erst am Freitag mit dem Problem weiter beschäftigen.
 Gruss

[BoskoBiati]

Hi,

gelöscht!

[lupo1]

Da ich weg muss, hier von mir noch ein textbasiertes Gantt mit mehreren Balken pro Zeile (Zeiterfassung, lässt sich aber auch auf Datümer statt Zeiten umstricken).

http://xxcl.de/0012.htm

[STELO96]

Hallo,

Ich hatte heute etwas Zeit und konnte mich mit Luzos Darstellung auseinander setzen.
Dadurch konnte ich einiges mitnehmen besonders im Bereich bedingtes Formatieren.
Habe eure Ideen sehr gut umsetzen können.

Ich danke euch vielmals!

Schönen Abend noch! :)

[Helvetier]

Hallo Stelo
Auch wenn das Problem bei Dir wahrscheinlich gelöst ist, im Anhang die von mir entwickelte Lösung. Ich habe mich dabei an Bedürfnissen orientiert, wie sie bei mir vorliegen: Die Projekte / Jobs sind einzeln verschiebbar, so dass gegenseitige Abhängigkeiten durch vertikales Verschieben auch optisch dargestellt werden können.
Der Code gehört im VBAProject in die Tabelle1(Terminplanung)
Gruss

Code:

Private Sub CommandButton1_Click()
   Dim strY
   If ActiveCell.Column = 1 Then
       If ActiveCell.Row >= Range("Tabelle1").Row Then
           If ActiveCell.Row <= Range("Tabelle1").Rows.Count + 4 Then
               If Application.CutCopyMode = 0 Then
                   strY = ActiveCell.Row
                   Range(Cells(strY, 1), Cells(strY, Range("Tabelle1").Columns.Count)).Cut
               Else
                   Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, Range("Tabelle1").Columns.Count)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
               End If
           End If
       End If
   End If
   ActiveCell.Select
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim strY
   If Target.Column = 1 Then
       If Target.Row >= Range("Tabelle1").Row Then
           If Target.Row <= Range("Tabelle1").Rows.Count + 4 Then
               ActiveSheet.Shapes("Commandbutton1").Top = Target.Rows.Top + (Target.Rows.Height - ActiveSheet.Shapes("Commandbutton1").Height) / 2
           End If
       End If
   End If
End Sub

[Helvetier]

Hallo
Schön, dass keiner die bugs bemerkt hat!! So ging keine durch mich verschuldete Zeit verloren.
Gruss

Code:

Option Explicit

Private Sub CommandButton1_Click()
   Dim sngY As Single
   Application.EnableEvents = False
   On Error GoTo Endhandler
   If ActiveCell.Column = 1 Then
       sngY = ActiveCell.Row
       If sngY >= Range("Tabelle1").Row Then
           If sngY <= Range("Tabelle1").Rows.Count + 4 Then
               If Application.CutCopyMode = 0 Then
                   'die Zeile wird ausgeschnitten
                   'die Caption des Button beschrieben für den nächsten Prozedurstart
                   Range(Cells(sngY, 1), Cells(sngY, Range("Tabelle1").Columns.Count)).Cut
                   ActiveSheet.CommandButton1.Caption = sngY
               Else
                   'eine freie Zeile wird eingefügt.
                   'der Dateninhalt der ausgeschnittenen Zeile wird eingefügt.
                   'die leere Zeile wird gelöscht.
                   Range(Cells(sngY, 1), Cells(sngY, Range("Tabelle1").Columns.Count)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                   If sngY > ActiveSheet.CommandButton1.Caption Then
                       'Es wurde oberhalb eine Zeile gelöscht, deshalb muss:
                       'der Cursor um eine Zeile nach oben korrigiert werden (Caption im Button).
                       'die Lage des Button korrigiert werden.
                       Cells(sngY - 1, 1).Select
                       ActiveSheet.Shapes("Commandbutton1").Top = Cells(sngY - 1, 1).Top + (Cells(sngY - 1, 1).Height - ActiveSheet.Shapes("Commandbutton1").Height) / 2
                   Else
                       Cells(sngY, 1).Select
                   End If
                   ActiveSheet.CommandButton1.Caption = ""
               End If
           End If
       End If
   End If
Endhandler:
   Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Target.Column = 1 Then
       If Target.Row >= Range("Tabelle1").Row Then
           If Target.Row <= Range("Tabelle1").Rows.Count + 4 Then
               With ActiveSheet.Shapes("Commandbutton1")
                   .Top = Target.Rows.Top + (Target.Rows.Height - .Height) / 2
               End With
           End If
       End If
   End If
End Sub