OpenOffice.info

Code: Alles auswählen

Rem Privates Modul. Makros in diesem Modul dürfen nicht über
Rem den Makrodialog ausführbar und die UDF nicht im
Rem Funktionsassistenten sichtbar sein.
Option Private Module
Rem Variablendeklaration erzwingen
Option Explicit
Rem Öffentlichen Typ erstellen
 Type PeriodStartStop
      Start As Double
      Stop_ As Double
 End Type
  
Rem *************************************************************************
Rem Beginn UDF "ZeitR"

Rem Erklärung Klammereinträge:

Rem Art: Schichtart, als Text ausgeben
Rem (as String). Angabe erforderlich

Rem BeginnArbeit: Beginn der Schicht, als Datum
Rem ausgeben (as Date). Angabe erforderlich

Rem EndeArbeit: Ende der Schicht, als Datum ausgeben
Rem (as Date). Angabe erforderlich

Rem ShiftStart: Beginn der zu berechnenden Periode,
Rem als Datum ausgeben (as Date). Angabe erforderlich

Rem ShiftEnd: Ende zu berechnenden Periode, als Datum
Rem ausgeben (as Date). Angabe erforderlich

Rem BeginnPauseEins: Beginn der 1. Pause, als Datum
Rem ausgeben (as Date). Angabe optional

Rem EndePauseEins: Ende der 1. Pause, als Datum ausgeben
Rem (as Date). Angabe optional

Rem BeginnPauseZwei, EndePauseZwei, BeginnPauseDrei
Rem und EndePauseDrei: wie PauseEins

Rem Beispiel Berechnung Nachtarbeit:
Rem Art = S (in A1)
Rem Beginn der Schicht 13:00 (in B1), Ende 00:39 (in C1).
Rem Beginn der zu berechnenden Zeit: 22:00 (in J1), Ende 06:00 (in K1)

Rem Beginn Pause: 21:50 (in D1), Ende 22:10 (in E1)
Rem Es soll nur Pausenzeit innerhalb der Periode berücksichtigt
Rem werden, also hier von 22:00 bis 22:10,

Rem die Pausezeit vor 22:00 soll hier nicht berücksichtigt werden.
Rem Das Ergebnis muss lauten: 02:29 (2 Stunden 29 Minuten Nachtarbeitszeit)

Rem Die notwendige Formel bei 1 Pause:
Rem =ZeitR(A1;B1;C1;J1;K1;D1;E1)
Rem oder Alternative Formel: =ZeitR(A1;B1;C1;"22:00";"06:00";D1;E1)

Rem Bei 3 Pausen lautet die Formel zum Beispiel:
Rem =ZeitR(A1;B1;C1;J1;K1;D1;E1;F1;G1;H1;I1)
Rem oder die alternative Formel:
Rem =ZeitR(A1;B1;C1;"22:00";"06:00";D1;E1;F1;G1;H1;I1)

Function ZeitR(Art As String, BeginnArbeit As Date, _
EndeArbeit As Date, ShiftStart As Date, ShiftEnd As Date, _
Optional BeginnPauseEins As Date, Optional EndePauseEins As Date, _
Optional BeginnPauseZwei As Date, Optional EndePauseZwei As Date, _
Optional BeginnPauseDrei As Date, Optional EndePauseDrei As Date) As Double

Rem Ende Einleitung
Rem **************************************************************************

Rem **************************************************************************
Rem Beginn Deklaration
On Error Resume Next
Dim i As Long
Dim j As Long
Dim Arbeit As Double
Dim PauseEins As Double
Dim PauseZwei As Double
Dim PauseDrei As Double
Dim Shift() As PeriodStartStop
Dim WorkedArbeit() As PeriodStartStop
Dim WorkedPauseEins() As PeriodStartStop
Dim WorkedPauseZwei() As PeriodStartStop
Dim WorkedPauseDrei() As PeriodStartStop
Rem Ende Deklaration
Rem ***************************************************************************

Rem ***************************************************************************
Rem Beginn Berechnung
Rem Kommen und Gehen
GetPeriods CDbl(BeginnArbeit), CDbl(EndeArbeit), WorkedArbeit()
GetPeriods CDbl(ShiftStart), CDbl(ShiftEnd), Shift()
    Arbeit = 0
    For i = 0 To UBound(WorkedArbeit())
      For j = 0 To UBound(Shift())
        Arbeit = Arbeit + GetOverlap(WorkedArbeit(i), Shift(j))
      Next j
    Next i

Rem Gehen und Kommen Pause 1
GetPeriods CDbl(BeginnPauseEins), CDbl(EndePauseEins), WorkedPauseEins()
GetPeriods CDbl(ShiftStart), CDbl(ShiftEnd), Shift()
    PauseEins = 0
    For i = 0 To UBound(WorkedPauseEins())
      For j = 0 To UBound(Shift())
       PauseEins = PauseEins + GetOverlap(WorkedPauseEins(i), Shift(j))
      Next j
    Next i

Rem Gehen und Kommen Pause 2
GetPeriods CDbl(BeginnPauseZwei), CDbl(EndePauseZwei), WorkedPauseZwei()
GetPeriods CDbl(ShiftStart), CDbl(ShiftEnd), Shift()
    PauseZwei = 0
    For i = 0 To UBound(WorkedPauseZwei())
      For j = 0 To UBound(Shift())
        PauseZwei = PauseZwei + GetOverlap(WorkedPauseZwei(i), Shift(j))
      Next j
    Next i

Rem Gehen und Kommen Pause 3
GetPeriods CDbl(BeginnPauseDrei), CDbl(EndePauseDrei), WorkedPauseDrei()
GetPeriods CDbl(ShiftStart), CDbl(ShiftEnd), Shift()
   PauseDrei = 0
    For i = 0 To UBound(WorkedPauseDrei())
      For j = 0 To UBound(Shift())
        PauseDrei = PauseDrei + GetOverlap(WorkedPauseDrei(i), Shift(j))
      Next j
    Next i
Rem Ende Berechnung

Rem Endberechnung
Rem Art (Spalte Art) = M, U oder K dann 0
If Art = "M" Or Art = "U" Or Art = "K" Then
ZeitR = 0
Else

Rem Zuerst wird die errechnete Arbeitszeit in das Dezimalformat
Rem konvertiert und gerundet. Danach werden die Pausenzeiten
Rem in das Dezimalformat konvertiert, gerunden und miteinander
Rem addiert. Das Ergebnis wird dann von der errechneten Arbeitszeit abgezogen.
Rem Zum Schluß wird das Gesamtergebnis wieder in das Zeitformat konvertiert.

ZeitR = (Round(Arbeit * 24, 5) - (Round(PauseEins * 24, 5) + _
Round(PauseZwei * 24, 5) + Round(PauseDrei * 24, 5))) / 24
End If
Rem Ende Endberechnung
End Function
Rem Ende UDF "ZeitR"
Rem ***************************************************************************

Rem Beginn Routine "GetPeriods"
Private Sub GetPeriods(ByVal t1 As Double, ByVal t2 As Double, _
Period() As PeriodStartStop)
    t1 = t1 - Int(t1)
    t2 = t2 - Int(t2)
    If t1 <= t2 Then
      ReDim Period(0 To 0)
      Period(0).Start = t1
      Period(0).Stop_ = t2
    Else
      ReDim Period(0 To 1)
      Period(0).Start = t1
      Period(0).Stop_ = 1
      Period(1).Start = 0
      Period(1).Stop_ = t2
    End If
  End Sub
Rem Ende Routine "GetPeriods"
  
Rem Beginn UDF "GetOverlap"
Private Function GetOverlap(Period1 As PeriodStartStop, _
Period2 As PeriodStartStop) As Double
    Dim t1 As Double
    Dim t2 As Double
    If Period1.Start >= Period2.Start Then
      t1 = Period1.Start
    Else
      t1 = Period2.Start
    End If
    If Period1.Stop_ <= Period2.Stop_ Then
      t2 = Period1.Stop_
    Else
      t2 = Period2.Stop_
    End If
    t2 = t2 - t1
    If t2 < 0 Then t2 = 0
    GetOverlap = t2
  End Function
Rem Ende UDf "GetOverlap"

Code: Alles auswählen

Type PeriodStartStop
      Start As Double
      Stop_ As Double
End Type

Code: Alles auswählen

Function [PFünf] (x As String)
Msgbox x
End Function

Code: Alles auswählen

Sub Main()
[PFünf] ("BlaBla")
End Sub

Code: Alles auswählen

Sub JanuarEin
Rem Schutz aufheben?
ThisComponent.Sheets(0).GetCellRangeByName("A12:A73").getRows.IsVisible = True
ThisComponent.Sheets(0).GetCellRangeByName("A74:A743").getRows.IsVisible = False
Rem Schutz wieder setzen?
End Sub