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
Folgende(r) 1 Nutzer sagt Danke an Helvetier für diesen Beitrag:1 Nutzer sagt Danke an Helvetier für diesen Beitrag 28 • STELO96
30.08.2017, 07:29 (Dieser Beitrag wurde zuletzt bearbeitet: 30.08.2017, 07:34 von 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).
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.
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
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
Folgende(r) 1 Nutzer sagt Danke an Helvetier für diesen Beitrag:1 Nutzer sagt Danke an Helvetier für diesen Beitrag 28 • Rabe