Microsoft Excel

Herbers Excel/VBA-Archiv

Einsatzplan:verschieben Farbbalken Anfangs/Endzeit


Betrifft: Einsatzplan:verschieben Farbbalken Anfangs/Endzeit von: Kunze, Sebastian
Geschrieben am: 23.01.2018 19:58:23

Hallo, Ich möchte gern einen Einsatzplan erstellen wo durch verschieben der Einsatzbalken(Farbbalken) die Anfangs und Endzeit angezeigt wird. Hintergrund ist die Planung von Kassenkräften wo man visuell einfacher eine Abdeckung planen kann.
mir würde reichen wenn er mir die Anfangszeit angibt und ich dann in die Endzeitzelle =zelle xy+8,5 eingebe, sodass ich die Endzeit sehe.

  

Betrifft: AW: Einsatzplan:verschieben Farbbalken Anfangs/Endzeit von: Kunze, Sebastian
Geschrieben am: 23.01.2018 19:59:40

https://www.herber.de/bbs/user/119202.xlsx


  

Betrifft: AW: Einsatzplan:verschieben Farbbalken Anfangs/Endzeit von: Sepp
Geschrieben am: 23.01.2018 23:17:17

Hallo Sebastian,

mit der Maus verschieben geht nicht, aber folgender Vorschlag.

Wenn du in einer Zeile mindestens 1 Stunde markierst wird der Balken eingetragen und die Zeit in die entsprechenden Felder geschrieben. Wenn du einen Balken komplett neu auswählst, werden die Markierung und die Zeiten entfernt.

Bei den Stunden 5 und 6 hast du einen Fehler in der Tabelle!

Folgenden Code in das Modul der Tabelle. (Rechtsklick auf das Blattregister > Code anzeigen und in das rechte Fenster einfügen)

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lngStart As Long, lngEnd As Long
If Not Intersect(Target, Range("E2:CC53")) Is Nothing Then
  If Target.Rows.Count = 1 And Target.Count >= 4 Then
    If Target.Interior.Color = RGB(51, 51, 153) Then
      Target.Interior.ColorIndex = xlNone
      Cells(Target.Row, 2).ClearContents
      Cells(Target.Row, 3).ClearContents
    Else
      Range(Cells(Target.Row, 5), Cells(Target.Row, 81)).Interior.ColorIndex = xlNone
      lngStart = (Target(1, 1).Column - 5) * 15
      lngEnd = (Target(1, Target.Columns.Count).Column - 4) * 15
      Cells(Target.Row, 2) = TimeSerial(5, lngStart, 0)
      Cells(Target.Row, 3) = TimeSerial(5, lngEnd, 0)
      Intersect(Target, Range("E2:CC53")).Interior.Color = RGB(51, 51, 153)
    End If
  End If
End If

End Sub


Gruß Sepp