Urlaubsplanung der Mitarbeiter in übersichtliches Excel Sheet exportieren

Hallo,

hilft das weiter?

Sub ExportCalendarExceptionsToExcel()

'Im Visual Basic Editor unter Extras - Verweise

'Microsoft Office x.0 Object Library

'und

'Micrososft Excel y.0 Object Library

'aktivieren (jeweile höchtse vorhandene Version verwenden)

Dim PC As Calendar

Dim RC As Calendar

Dim Ex As Exception

Dim R As Resource

Dim T As Task

Dim P As Project

Dim D As Date

Dim obj_App As Object

Dim Row As Integer

Dim Column As Integer

Dim WHours As Double

Set P = ActiveProject

Set PC = P.Calendar

On Error Resume Next

Set obj_App = Nothing

Set obj_App = GetObject(, "Excel.Application")

On Error GoTo 0

If obj_App Is Nothing Then

Set obj_App = CreateObject("Excel.Application")

End If

obj_App.Visible = True

On Error Resume Next

Set obj_File = obj_App.ActiveWorkbook

On Error GoTo 0

If obj_File Is Nothing Then

Set obj_File = obj_App.Workbooks.Add

'New workbook, we can use default sheet

Set obj_Target = obj_File.ActiveSheet

Else

'Existing workbook, get a new sheet to avoid overwrite

Set obj_Target = obj_File.Sheets.Add

End If

obj_Target.Cells(1, 1) = "Datum"

obj_Target.Cells(1, 2) = "Ausnahme"

obj_Target.Cells(1, 3) = "Projekt/Resource"

obj_Target.Cells(1, 4) = "Arbeitszeit"

Row = 2

For D = P.ProjectSummaryTask.Start To P.ProjectSummaryTask.Finish

D = DateSerial(Year(D), Month(D), Day(D))

For Each Ex In PC.Exceptions

If Ex.Start <= D And Ex.Finish >= D Then

WHours = 0

obj_Target.Cells(Row, 1) = D

obj_Target.Cells(Row, 2) = Ex.Name

obj_Target.Cells(Row, 3) = "Projektkalender: " & PC.Name

If Ex.Shift1.Start = 0 Then

obj_Target.Cells(Row, 4) = 0

Else

WHours = DateDiff("h", Ex.Shift1.Start, Ex.Shift1.Finish)

If Ex.Shift2.Start <> 0 Then

WHours = WHours + DateDiff("h", Ex.Shift2.Start, Ex.Shift2.Finish)

If Ex.Shift3.Start <> 0 Then

WHours = WHours + DateDiff("h", Ex.Shift3.Start, Ex.Shift3.Finish)

If Ex.Shift4.Start <> 0 Then

WHours = WHours + DateDiff("h", Ex.Shift4.Start, Ex.Shift4.Finish)

If Ex.Shift5.Start <> 0 Then

WHours = WHours + DateDiff("h", Ex.Shift5.Start, Ex.Shift5.Finish)

End If

End If

End If

End If

obj_Target.Cells(Row, 4) = WHours

End If

Row = Row + 1

End If

Next Ex

For Each R In P.Resources

Set RC = R.Calendar

If RC.Period(D, D).Parent.Exceptions.Count > 0 Then

WHours = 0

For Each Ex In RC.Exceptions

If Ex.Start <= D And Ex.Finish >= D Then

obj_Target.Cells(Row, 1) = D

obj_Target.Cells(Row, 2) = Ex.Name

obj_Target.Cells(Row, 3) = R.Name

If Ex.Shift1.Start = 0 Then

obj_Target.Cells(Row, 4) = 0

Else

WHours = DateDiff("h", Ex.Shift1.Start, Ex.Shift1.Finish)

If Ex.Shift2.Start <> 0 Then

WHours = WHours + DateDiff("h", Ex.Shift2.Start, Ex.Shift2.Finish)

If Ex.Shift3.Start <> 0 Then

WHours = WHours + DateDiff("h", Ex.Shift3.Start, Ex.Shift3.Finish)

If Ex.Shift4.Start <> 0 Then

WHours = WHours + DateDiff("h", Ex.Shift4.Start, Ex.Shift4.Finish)

If Ex.Shift5.Start <> 0 Then

WHours = WHours + DateDiff("h", Ex.Shift5.Start, Ex.Shift5.Finish)

End If

End If

End If

End If

obj_Target.Cells(Row, 4) = WHours

End If

Row = Row + 1

End If

Next Ex

End If

Next R

Next D

obj_Target.Columns("A:C").EntireColumn.AutoFit

obj_Target.Columns("A:C").VerticalAlignment = xlTop

End Sub

Viele Grüße

Barbara

Ich wollte den Kanalkalender gerade für die Urlaubsplanung des Teams verwenden, aber leider musste ich auch feststellen, dass dieser am Smartphone nicht verfügbar ist! Gibt es eine einfache alternative um Urlaube übersichtlich in Teams darzustellen bzw. auch noch einen Freigabeprozess anzulegen?
<br />

Hallo Susanne,

kenne die Mappe um die es bei dir geht natürlich nicht und kann so auch nicht treffend sagen, ob meine Idee umsetzbar wäre. Aber ein eigenes Sheet in dem sich die Auswertung der sich ständig ändernden Daten vollzieht könnte man mit bedingten Formatierungen
die sich nur auf dieses Arbeitsblatt angewendet werden relativ übersichtlich gestalten.

Sollte in diesem Sheet eine Spalte oder ähnliches hinzugefügt werden, dann wäre es wichtig nicht die bereits bedingt formatierten Teile zu kopieren.

Möglicherweise schreibe ich hier etwas, das dir sowieso klar ist. Aber vielleicht hilft es doch.

Liebe Grüße

Bernhard

Ich will verschiedene Aufgaben verschiedenen Mitarbeitern zuweisen und gleichzeitig sollen deren Abwesenheiten (zum Beispiel Urlaub) berücksichtigt werden.

Um sich die Struktur (stark vereinfacht) vorzustellen:

Tabelle1 (Mitarbeiter) um Mitarbeitern Funktionen zuzuweisen:

Mitarbeitername

Aufgabe1 ja/nein-Feld

Aufgabe2 ja/nein-Feld

Tabelle2 (Wochenplan) für die wöchentliche Aufgabenverteilung:

Datum

Aufgabe1 Mitarbeiter gefiltert nach Tabelle1

Aufgabe2 Mitarbeiter gefiltert nach Tabelle1

Soweit so gut.

Jetzt kommt die Urlaubsplanung dazu. Wie mache ich das so, dass die Mitarbeiter die an den entsprechenden Tagen nicht da sind, gar nicht erst in Tabelle2 zur Verfügung stehen?

Vom Grundsatz brauche ich doch dazu eine dritte Tabelle mit dem Datum, den Mitarbeitern und der Frage ob sie anwesend sind oder nicht. Ich kann aber doch schlecht für jeden einzelnen der Mitarbeiter eine Spalte basteln und
je nach Fluktuation hinzufügen oder wieder löschen. Was wäre eine sinnvolle Struktur? Und wie kann ich damit die Nachschlagewerte aus Tabelle2 eingrenzen?

Habe schon verschiedene Tabellen und Abfragemöglichkeiten durchgespielt, aber noch keine richtige Lösung gefunden.

Ich hoffe, dazu hat irgendjemand eine gute Idee…

Hallo griko777,

ich empfehle dir deine Anfrage im
MSDN Forum zu schreiben. Access wird nähmlich dort täglich unterstützt.

Ich denke, dass du deine Lösungschancen hiermit erhöhen könntest.

Bei weiteren Fragen stehe ich zu Verfügung.

MfG

Hallo Andreas,

http://www.smarttools-publishing.de/...iceDDE-Fix.zip

Habe ich installiert, behebt auch das Problem, ABER:

danach wurde für jedes Excel Sheet eine neue Instanz von Excel geöffnet UND das kopieren und einfügen von Daten von einem Excel Sheet in ein anderes funktioniert nicht mehr!

Wer hat noch eine Idee?