Hallo Hajo
Der Code ist elends lang.
Aber ich probiere es einmal.
Wünsche ein Prosit Neujahr.
Gruß
Heinz
Private Sub CB_Aus_Click()
Application.ScreenUpdating = False
MyLabel = ""
MA_Fehl.Visible = False
ListFehl.Clear
ListFehl.Visible = False
Application.ScreenUpdating = True
End Sub
Private Sub CB_Ein_Click()
'Makro starten und Fehlende Mitarbeiter auflisten
Dim SuchSpalte As Long, i As Long, k As Long, u As Long, MyChk As Long
Dim ChkStr As Variant, MyArr(1)
Dim ci As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
k = 0
u = 0
MyChk = 0
UserForm2.ListFehl.Clear
SuchSpalte = ComboBoxDatum.ListIndex + 3 'listindex startet mit 0!!
For i = 3 To 154
ChkStr = Trim(Cells(i, SuchSpalte).Value)
If UCase(Cells(i, SuchSpalte).Value) = "K" Then
UserForm2.ListFehl.AddItem Cells(i, 1).Value & " Krank"
k = k + 1
End If
Next i
For i = 3 To 154
ChkStr = Trim(Cells(i, SuchSpalte).Value)
If UCase(Cells(i, SuchSpalte).Value) = "U" Then
UserForm2.ListFehl.AddItem Cells(i, 1).Value & " Urlaub"
u = u + 1
End If
Next i
For i = 3 To 154
ChkStr = Trim(Cells(i, SuchSpalte).Value)
If UCase(Cells(i, SuchSpalte).Value) = "B" Then
UserForm2.ListFehl.AddItem Cells(i, 1).Value & " Bezahlte Freizeit"
u = u + 1
End If
Next i
For i = 3 To 154
ChkStr = Trim(Cells(i, SuchSpalte).Value)
If UCase(Cells(i, SuchSpalte).Value) = "A" Then
UserForm2.ListFehl.AddItem Cells(i, 1).Value & " Andere Abwesenheit"
u = u + 1
End If
Next i
For i = 3 To 154
ChkStr = Trim(Cells(i, SuchSpalte).Value)
If UCase(Cells(i, SuchSpalte).Value) = "ZA" Then
UserForm2.ListFehl.AddItem Cells(i, 1).Value & " Zeitausgleich"
u = u + 1
End If
Next i
If u > 0 Then
MyArr(0) = 1
End If
If k > 0 Then
MyArr(1) = 1
End If
If MyArr(0) = 0 And MyArr(1) = 0 Then 'kein Urlaub, keine Krankmeldung
MA_Fehl.Visible = True
ListFehl.Visible = False
'MyLabel.Caption = "Keine Urlaubs- oder" & vbCrLf & "Krankmeldung"
MyLabel.Caption = "Niemand abwesend " '& vbCrLf & "Krankmeldung"
ElseIf MyArr(0) > 0 And MyArr(1) > 0 Then
MA_Fehl.Visible = True
ListFehl.Visible = True
'MyLabel.Caption = "Krank- und" & vbCrLf & "Abwesenheit:"
MyLabel.Caption = "Abwesende Mitarbeiter(innen)" & vbCrLf ' & "Abwesenheit:"
ElseIf MyArr(0) = 0 And MyArr(1) > 0 Then
MA_Fehl.Visible = True
ListFehl.Visible = True
MyLabel.Caption = "Krankmeldung:"
ElseIf MyArr(0) > 0 And MyArr(1) = 0 Then
MA_Fehl.Visible = True
ListFehl.Visible = True
MyLabel.Caption = "Abwesenheit:"
End If
MyArr(0) = 0
MyArr(1) = 0
Application.ScreenUpdating = True
End Sub
Private Sub ComboBoxDatum_Change()
If ComboBoxSchicht.Value "" And ComboBoxDatum.Value "" Then
Call Loesche_Form
Call Fuelle_Form
ElseIf ComboBoxDatum.Value "" Then
If MA_Fehl.Visible = False Then
CB_Ein.Enabled = True
Else
CB_Ein_Click
End If
End If
End Sub
Private Sub ComboBoxSchicht_Change()
If ComboBoxDatum.Value "" And ComboBoxSchicht.Value "" Then
Call Loesche_Form
Call Fuelle_Form
End If
End Sub
Private Sub UserForm_Initialize()
Application.EnableEvents = False
'Userform wird auf die Größe von Excel gezoomt, wobei die
'die Controls entsprechend gezoomt und zentriert werden.
'Uwe Küstner 20070622
Dim Faktor As Single
Dim x As Single, Y As Single
Dim sngL As Single, sngO As Single, sngR As Single, sngU As Single
Dim oC As MSForms.Control
Faktor = Application.Height / (Me.Height - 20)
If Faktor 4 Then Faktor = 4
Me.Width = Application.Width
Me.Height = Application.Height
sngL = Me.Width
sngO = Me.Height
For Each oC In Me.Controls
sngL = Application.WorksheetFunction.Min(sngL, oC.Left)
sngO = Application.WorksheetFunction.Min(sngO, oC.Top)
sngR = Application.WorksheetFunction.Max(sngR, oC.Left + oC.Width)
sngU = Application.WorksheetFunction.Max(sngU, oC.Top + oC.Height)
Next oC
x = (Me.Width - (sngR * Faktor) - (sngL * Faktor)) / 2 / Faktor
Y = (Me.Height - (sngO * Faktor) - (sngU * Faktor) - 20) / 2 / Faktor
Me.Controls.Move x, Y
Me.Zoom = Faktor * 100
Set Sh = ActiveSheet
For Each v In Sh.Range("C1:AG1")
On Error GoTo skip_Error
If v "" Then
ComboBoxDatum.AddItem v
End If
skip_Error:
On Error GoTo 0
Next
If Month(ActiveSheet.Range("a1").Value) = Month(Date) Then
ComboBoxDatum.ListIndex = Day(Date) - 1
End If
Set Sh = ActiveSheet
For v = 1 To 3
ComboBoxSchicht.AddItem v
Next
With UF
.MaxButton = True
.MinButton = True
.BorderStyle = xlFest
.Create Me
End With
ComboBoxSortierer1_1.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer1_1.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer2_2.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer3_3.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer4_4.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer5_5.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer6_6.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer7_7.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer8_8.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer9_9.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSortierer10_10.RowSource = "Personalbesetzung!B51:B66"
ComboBoxAnlernen1_1.RowSource = "Personalbesetzung!B51:B66"
ComboBoxAnlernen2_2.RowSource = "Personalbesetzung!B51:B66"
ComboBoxAnlernen3_3.RowSource = "Personalbesetzung!B51:B66"
ComboBoxFerialarbeiter1_1.RowSource = "Personalbesetzung!B51:B66"
ComboBoxFerialarbeiter2_2.RowSource = "Personalbesetzung!B51:B66"
ComboBoxFerialarbeiter3_3.RowSource = "Personalbesetzung!B51:B66"
ComboBoxZusätzliche_MA1_1.RowSource = "Personalbesetzung!B51:B66"
ComboBoxZusätzliche_MA2_2.RowSource = "Personalbesetzung!B51:B66"
ComboBoxZusätzliche_MA3_3.RowSource = "Personalbesetzung!B51:B66"
ComboBoxRegie1_1.RowSource = "Personalbesetzung!B51:B66"
ComboBoxRegie2_2.RowSource = "Personalbesetzung!B51:B66"
ComboBoxSchichtMeister.RowSource = "Personalbesetzung!B80:B87" 'Schichtmeister
Application.EnableEvents = True
End Sub
Sub Fuelle_Form()
Dim SuchSpalte As Long, i As Long, j As Long, k As Long, L As Long, R As Long, A As Long
Dim ChkStr As Variant, HTyp As String, MAZahl As Long, MAhide As Long
Dim ci As Long
Application.EnableEvents = False
A = 1
j = 1
k = 1
L = 1
R = 1
MAZahl = 0
MAhide = 0
SuchSpalte = ComboBoxDatum.ListIndex + 3 'listindex startet mit 0!!
'suche Vorarbeiter
For i = 3 To 154
ChkStr = Trim(Cells(i, SuchSpalte).Value)
StrAuswertung:
If Not ChkStr = "" Then
'Sonderzeiten auswerten
On Error Resume Next
ChkStr = Val(ChkStr)
On Error GoTo 0
If Not WorksheetFunction.IsNumber(ChkStr) Then
HTyp = UCase(Left(ChkStr, 1))
Select Case HTyp
Case "Ü" 'Überstunden
HTyp = "Überstunden"
ChkStr = Mid(ChkStr, 2, Len(ChkStr) - 1)
GoTo StrAuswertung
Case "E" 'Einbringstunden
HTyp = "Einbringstunden"
ChkStr = Mid(ChkStr, 2, Len(ChkStr) - 1)
GoTo StrAuswertung
Case "Z" 'Zeitausgleich
HTyp = "Arbeitet auf Zeitausgleich"
ChkStr = Mid(ChkStr, 2, Len(ChkStr) - 1)
GoTo StrAuswertung
Case Else
' falls noch ein anderer Stundentyp bearbeitet werden soll diesen hier definieren
End Select
If Len(HTyp) = 1 Then
HTyp = ""
End If
End If
'Debug.Print "Chkstr " & ChkStr & " is number: " & WorksheetFunction.IsNumber(ChkStr)
'Hier Regie und Anlerner
If ChkStr = 7 Then 'Regie
Debug.Print ChkStr
If 1 = Val(ComboBoxSchicht.Value) Then
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "ComboBoxRegie" & R Then
UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
MAZahl = MAZahl + 1
ci = UserForm2.Controls.Count - 1
R = R + 1
End If
Next ci
End If
ElseIf ChkStr = 4 Then 'Anlerner Schicht1
Debug.Print ChkStr
If 1 = Val(ComboBoxSchicht.Value) Then
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "ComboBoxAnlernen" & A Then
UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
MAZahl = MAZahl + 1
ci = UserForm2.Controls.Count - 1
A = A + 1
End If
Next ci
End If
ElseIf ChkStr = 4 Then
Debug.Print ChkStr
If 2 = Val(ComboBoxSchicht.Value) Then
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "ComboBoxAnlernen" & A Then
UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
MAZahl = MAZahl + 1
ci = UserForm2.Controls.Count - 1
A = A + 1
End If
Next ci
End If
ElseIf ChkStr = 4 Then
Debug.Print ChkStr
If 3 = Val(ComboBoxSchicht.Value) Then
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "ComboBoxAnlernen" & A Then
UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
MAZahl = MAZahl + 1
ci = UserForm2.Controls.Count - 1
A = A + 1
End If
Next ci
End If
ElseIf Len(ChkStr) = 2 And Mid(ChkStr, 1, 1) = 1 Then
'hier die Vorarbeiter
'Debug.Print chkstr
If CStr(Right(ChkStr, 1)) = ComboBoxSchicht.Value Then
ComboBoxVorarbeiter.Value = Cells(i, 1).Value
ComboBoxVorarbeiter.BackColor = &HFFFFFF
MAZahl = MAZahl + 1
If HTyp "" Then
TextBoxVorarbeiter.Value = HTyp
TextBoxVorarbeiter.BackColor = &HFFFFFF
Else
TextBoxVorarbeiter.BackColor = &HE0E0E0
End If
End If
ElseIf CStr(ChkStr) = ComboBoxSchicht.Value Then
'hier die Sortierer
If j
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "ComboBoxSortierer" & j Then
UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
MAZahl = MAZahl + 1
ci = UserForm2.Controls.Count - 1
End If
Next ci
If HTyp "" Then
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "TextBoxSortierer" & j Then
UserForm2.Controls.Item(ci).Value = HTyp
UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
ci = UserForm2.Controls.Count - 1
End If
Next ci
Else
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "TextBoxSortierer" & j Then
Debug.Print UserForm2.Controls.Item(ci).Name
UserForm2.Controls.Item(ci).BackColor = &HE0E0E0
ci = UserForm2.Controls.Count - 1
End If
Next ci
End If
Else
MAhide = MAhide + 1
End If
j = j + 1
ElseIf ChkStr = 20 + ComboBoxSchicht.Value Then
'hier der Schrumpfer
ComboBoxSchrumpfer.Value = Cells(i, 1).Value
ComboBoxSchrumpfer.BackColor = &HFFFFFF
MAZahl = MAZahl + 1
If HTyp "" Then
TextBoxSchrumpfer.Value = HTyp
TextBoxSchrumpfer.BackColor = &HFFFFFF
Else
TextBoxSchrumpfer.BackColor = &HE0E0E0
End If
ElseIf ChkStr = "S" And ComboBoxSchicht.Value = 1 Then
'hier der Schrumpfer Springer
ComboBoxSchrumpfer_Springer.Value = Cells(i, 1).Value
ComboBoxSchrumpfer_Springer.BackColor = &HFFFFFF
MAZahl = MAZahl + 1
ElseIf Left(ChkStr, 1) = 3 And Right(ChkStr, 1) = ComboBoxSchicht.Value Then
'hier Qualitaetssicherung
ComboBoxQS.Value = Cells(i, 1).Value
ComboBoxQS.BackColor = &HFFFFFF
MAZahl = MAZahl + 1
If HTyp "" Then
TextBoxQS.Value = HTyp
TextBoxQS.BackColor = &HFFFFFF
Else
TextBoxQS.BackColor = &HE0E0E0
End If
End If
HTyp = ""
End If
Next i
For i = 184 To 199
'Das ist der Bereich fuer die Ferialarbeiter
If Left(Cells(i, SuchSpalte).Value, 1) = ComboBoxSchicht.Value Then
'hier die Ferialarbeiter
If L
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "ComboBoxFerialarbeiter" & L Then
UserForm2.Controls.Item(ci).Value = Cells(i, 1).Value
UserForm2.Controls.Item(ci).BackColor = &HFFFFFF
MAZahl = MAZahl + 1
ci = UserForm2.Controls.Count - 1
End If
Next ci
If HTyp "" Then
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "TextBoxFerialarbeiter" & L Then
UserForm2.Controls.Item(ci).Value = HTyp
UserForm2.Controls.Item(ci).BackColor = "H00FFFFFF&"
ci = UserForm2.Controls.Count - 1
End If
Next ci
Else
For ci = 0 To UserForm2.Controls.Count - 1
If UserForm2.Controls.Item(ci).Name = "TextBoxFerialarbeiter" & L Then
UserForm2.Controls.Item(ci).BackColor = &HE0E0E0
ci = UserForm2.Controls.Count - 1
End If
Next ci
End If
Else
MAhide = MAhide + 1
End If
L = L + 1
End If
Next i
Application.EnableEvents = True
End Sub
Sub Loesche_Form()
Dim ci As Long
Application.EnableEvents = False
For ci = 0 To UserForm2.Controls.Count - 1
Debug.Print UserForm2.Controls.Item(ci).Name
If InStr(1, UserForm2.Controls.Item(ci).Name, "TextBox") 0 Or InStr(1, UserForm2.Controls.Item(ci).Name, "ComboBox") Then
If InStr(1, UserForm2.Controls.Item(ci).Name, "Datum") = 0 And InStr(1, UserForm2.Controls.Item(ci).Name, "Schicht") = 0 Then
UserForm2.Controls.Item(ci).Value = ""
Debug.Print UserForm2.Controls.Item(ci).Name
Debug.Print Right(UserForm2.Controls.Item(ci).Name, Len(UserForm2.Controls.Item(ci).Name) - 7)
If Right(UserForm2.Controls.Item(ci).Name, Len(UserForm2.Controls.Item(ci).Name) - 7) > 23 Then
UserForm2.Controls.Item(ci).BackColor = &HE0E0E0
End If
End If
End If
Next ci
Application.EnableEvents = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
UserForm2.Hide
Unload UserForm2
End Sub
Private Sub CommandButton1_Click()
Sheets("Personalbesetzung").Unprotect Password:="vetro"
'Sheets("Personaldruck").Unprotect Password:="vetro"
'Sheets("Personaldruck").Range("E5,G5,M5,O5,D6:D7,L6:L7,D9:G31,B20:C24,L9:O31,J20:K24"). _
ClearContents 'Ausfüllbereiche leeren
'Sheets("Personaldruck").Protect Password:="vetro"
Application.EnableEvents = False
Application.ScreenUpdating = False
If ComboBoxSchicht.Text = "" Then
MsgBox "Sie haben keine Schicht ausgewählt"
Exit Sub
End If
If ComboBoxDatum.Text = "" Then
MsgBox "Sie haben kein Datum ausgewählt"
Exit Sub
End If
If ComboBoxSchichtMeister.Text = "" Then
MsgBox "Sie haben keinen Schichtmeister ausgewählt"
Exit Sub
End If
If ComboBoxQS.Text = "" Then
MsgBox "Die QS ist nicht besetzt"
Exit Sub
End If
If ComboBoxSchrumpfer.Text = "" Then
MsgBox "Kein Schrumpfer"
Exit Sub
End If
If ComboBoxVorarbeiter.Text = "" Then
MsgBox "Kein Vorarbeiter"
Exit Sub
End If
If ComboBoxSortierer1_1.Text = "" Then
MsgBox "Keine Sortierer"
Exit Sub
End If
Dim ZeileReserve As Long, iIndex As Long
Me.Hide
With Sheets("Personalbesetzung")
.Unprotect Password:="vetro"
'Ausfüllbereiche leeren
.Range("E9:V26").ClearContents
.Range("P27:R35").ClearContents
.Range("C21:D26").ClearContents
.Range("C28:O31").ClearContents
.Range("S27:V31").ClearContents
.Range("D9:D20").ClearContents
.Range("F27:H27").ClearContents
.Range("F32:J32").ClearContents
.Range("C33:O34").ClearContents
.Range("S33:V33").ClearContents
.Range("B9:B37").ClearContents
.Range("A9:V38").Interior.ColorIndex = xlNone
ZeileReserve = 20 'Zeilenzähler für Reserve-Personal
.Range("Q5") = ComboBoxDatum 'Datum
.Range("U5") = ComboBoxSchicht 'Schicht
.Range("F7") = ComboBoxSchichtMeister 'Schichtmeister
.Range("E32") = ComboBoxSchrumpfer 'Schrumpfer
.Range("E27") = ComboBoxQS 'QS
.Range("K5") = ComboBoxVorarbeiter 'Vorarbeiter
'Sortierer 1 bis 10
For iIndex = 1 To 10
If fncPersonal(sName:=Me.Controls("ComboBoxSortierer" & j + iIndex).Value, _
sTaetigkeit:=Me.Controls("ComboBoxSortierer" & j + iIndex).Value, _
lZeile:=ZeileReserve) = True Then Me.Show: Exit Sub
Next
'Anlerner 1
Call fncPersonal(sName:=ComboBoxAnlernen1, sTaetigkeit:=ComboBoxAnlernen1_1, lZeile:= _
ZeileReserve)
'Anlerner 2
Call fncPersonal(sName:=ComboBoxAnlernen2, sTaetigkeit:=ComboBoxAnlernen2_2, lZeile:= _
ZeileReserve)
'Anlerner 3
Call fncPersonal(sName:=ComboBoxAnlernen3, sTaetigkeit:=ComboBoxAnlernen3_3, lZeile:= _
ZeileReserve)
'Ferialarbeiter 1 bis 3
For iIndex = 1 To 3
If fncPersonal(sName:=Me.Controls("TextBoxFerialarbeiter" & L + iIndex).Value, _
sTaetigkeit:=Me.Controls("ComboBoxFerialarbeiter" & L + iIndex).Value, _
lZeile:=ZeileReserve) = True Then Me.Show: Exit Sub
Next
Unload Me
.Range("A1").Copy
.Range("A1").PasteSpecial xlPasteFormats
Sheets("Personalbesetzung").Select
Application.CutCopyMode = False
End With
With Sheets("Personalbesetzung")
.Protect Password:="vetro"
End With
With Sheets("Personaldruck")
.Unprotect Password:="vetro"
End With
Worksheets("Personalbesetzung").Range("Q5").Copy
Worksheets("Personaldruck").Range("M5,E5").PasteSpecial Paste:=xlValues 'Datum
Worksheets("Personalbesetzung").Range("U5").Copy
Worksheets("Personaldruck").Range("G5,O5").PasteSpecial Paste:=xlValues 'Schicht
Worksheets("Personalbesetzung").Range("K5").Copy
Worksheets("Personaldruck").Range("D7,L7").PasteSpecial Paste:=xlValues 'Vorarbeiter
Worksheets("Personalbesetzung").Range("F7").Copy
Worksheets("Personaldruck").Range("D6,L6").PasteSpecial Paste:=xlValues 'Schichtmeister
Worksheets("Personalbesetzung").Range("E10").Copy
Worksheets("Personaldruck").Range("D9").PasteSpecial Paste:=xlValues 'L:311+P:
Worksheets("Personalbesetzung").Range("G10").Copy
Worksheets("Personaldruck").Range("F9,N9").PasteSpecial Paste:=xlValues 'L:311+P:
Worksheets("Personalbesetzung").Range("E11").Copy
Worksheets("Personaldruck").Range("D10,L10").PasteSpecial Paste:=xlValues 'L:312+P:
Worksheets("Personalbesetzung").Range("G11").Copy
Worksheets("Personaldruck").Range("F10,N10").PasteSpecial Paste:=xlValues 'L:312+P:
Worksheets("Personalbesetzung").Range("E12").Copy
Worksheets("Personaldruck").Range("D11,L11").PasteSpecial Paste:=xlValues 'L:321+P:+322+P:
Worksheets("Personalbesetzung").Range("G12").Copy
Worksheets("Personaldruck").Range("F11,N11").PasteSpecial Paste:=xlValues 'L:321+P:+322+P:
Worksheets("Personalbesetzung").Range("E13").Copy
Worksheets("Personaldruck").Range("D12,L12").PasteSpecial Paste:=xlValues 'L:321+P:
Worksheets("Personalbesetzung").Range("G13").Copy
Worksheets("Personaldruck").Range("F12,N12").PasteSpecial Paste:=xlValues 'L:321+P:
Worksheets("Personalbesetzung").Range("E14").Copy
Worksheets("Personaldruck").Range("D13,L13").PasteSpecial Paste:=xlValues 'L:322+P:
Worksheets("Personalbesetzung").Range("G14").Copy
Worksheets("Personaldruck").Range("F13,N13").PasteSpecial Paste:=xlValues 'L:312+P:
Worksheets("Personalbesetzung").Range("E15").Copy
Worksheets("Personaldruck").Range("D14,L14").PasteSpecial Paste:=xlValues 'L:331+P:+332+P:
Worksheets("Personalbesetzung").Range("G15").Copy
Worksheets("Personaldruck").Range("F14,N14").PasteSpecial Paste:=xlValues 'L:331+P:+332+P:
Worksheets("Personalbesetzung").Range("E16").Copy
Worksheets("Personaldruck").Range("D15,L15").PasteSpecial Paste:=xlValues 'L:331+P:
Worksheets("Personalbesetzung").Range("G16").Copy
Worksheets("Personaldruck").Range("F15,N15").PasteSpecial Paste:=xlValues 'L:331+P:
Worksheets("Personalbesetzung").Range("E17").Copy
Worksheets("Personaldruck").Range("D16,L16").PasteSpecial Paste:=xlValues 'L:332+P:+333+P:
Worksheets("Personalbesetzung").Range("G17").Copy
Worksheets("Personaldruck").Range("F16,N16").PasteSpecial Paste:=xlValues 'L:332+P:+333+P:
Worksheets("Personalbesetzung").Range("E18").Copy
Worksheets("Personaldruck").Range("D17,L17").PasteSpecial Paste:=xlValues 'L:332+P
Worksheets("Personalbesetzung").Range("G18").Copy
Worksheets("Personaldruck").Range("F17,N17").PasteSpecial Paste:=xlValues 'L:332+P
Worksheets("Personalbesetzung").Range("E19").Copy
Worksheets("Personaldruck").Range("D18,L18").PasteSpecial Paste:=xlValues 'L:333+P:
Worksheets("Personalbesetzung").Range("G19").Copy
Worksheets("Personaldruck").Range("F18,N18").PasteSpecial Paste:=xlValues 'L:333+P:
Worksheets("Personalbesetzung").Range("C21").Copy
Worksheets("Personaldruck").Range("D19,L19").PasteSpecial Paste:=xlValues 'Reserve1
Worksheets("Personalbesetzung").Range("C22").Copy
Worksheets("Personaldruck").Range("F19,N19").PasteSpecial Paste:=xlValues 'Reserve2
Worksheets("Personalbesetzung").Range("C23").Copy
Worksheets("Personaldruck").Range("B20,J20").PasteSpecial Paste:=xlValues 'Reserve3
Worksheets("Personalbesetzung").Range("C24").Copy
Worksheets("Personaldruck").Range("D20,L20").PasteSpecial Paste:=xlValues 'Reserve4
Worksheets("Personalbesetzung").Range("C25").Copy
Worksheets("Personaldruck").Range("F20,N20").PasteSpecial Paste:=xlValues 'Reserve5
Worksheets("Personalbesetzung").Range("C26").Copy
Worksheets("Personaldruck").Range("B21,J21").PasteSpecial Paste:=xlValues 'Reserve6
Worksheets("Personalbesetzung").Range("E27").Copy
Worksheets("Personaldruck").Range("D25,L25").PasteSpecial Paste:=xlValues 'QS
Worksheets("Personalbesetzung").Range("E28").Copy
Worksheets("Personaldruck").Range("D26,L26").PasteSpecial Paste:=xlValues 'QS Anlernen
Worksheets("Personalbesetzung").Range("E32").Copy
Worksheets("Personaldruck").Range("D29,L29").PasteSpecial Paste:=xlValues 'Schrumpfer
Worksheets("Personalbesetzung").Range("E33").Copy
Worksheets("Personaldruck").Range("D30,L30").PasteSpecial Paste:=xlValues 'Schrumpfer Anlernen
'Linie 311
If Range("E10") "" Then
Range("C10") = "L:311+P:"
End If
If Range("G10") "" Then
Range("C10") = "L:311+P:"
End If
If Range("E10") "" Then
Range("I10") = 8
End If
If Range("G10") "" Then
Range("I10") = 8
End If
If Range("E10") "" And Range("G10") "" Then
Range("I10") = 16
End If
'Linie 312
If Range("E11") "" Then
Range("C11") = "L:312+P:"
End If
If Range("E11") "" Then
Range("J11") = 8
End If
If Range("G11") "" Then
Range("J11") = 8
End If
If Range("E11") "" And Range("G11") "" Then
Range("J11") = 16
End If
'Linie 321+322
If Range("E12") "" Then
Range("C12") = "L:321+P:+322+P:"
End If
If Range("G12") "" Then
Range("C12") = "L:321+P:+322+P:"
End If
If Range("E12") "" Then
Range("K12") = 4
End If
If Range("G12") "" Then
Range("K12") = 4
End If
If Range("E12") "" Then
Range("L12") = 4
End If
If Range("E12") "" And Range("G12") "" Then
Range("K12") = 8
End If
If Range("E12") "" And Range("G12") "" Then
Range("L12") = 8
End If
'Linie 321
If Range("E13") "" Then
Range("C13") = "L:321+P:"
End If
If Range("G13") "" Then
Range("C13") = "L:321+P:"
End If
If Range("E13") "" Then
Range("K13") = 8
End If
If Range("G13") "" Then
Range("K13") = 8
End If
If Range("E13") "" And Range("G13") "" Then
Range("K13") = 16
End If
'Linie 322
If Range("E14") "" Then
Range("C14") = "L:322+P:"
End If
If Range("G14") "" Then
Range("C14") = "L:322+P:"
End If
If Range("E14") "" Then
Range("L14") = 8
End If
If Range("G14") "" Then
Range("L14") = 8
End If
If Range("E14") "" And Range("G14") "" Then
Range("L14") = 16
End If
'Linie 331+332
If Range("E15") "" Then
Range("C15") = "L:331+P:+332+P:"
End If
If Range("G15") "" Then
Range("C15") = "L:331+P:+332+P:"
End If
If Range("E15") "" Then
Range("M15") = 6
End If
If Range("E15") "" Then
Range("N15") = 2
End If
'Linie 331
If Range("E16") "" Then
Range("C16") = "L:331+P:"
End If
If Range("G16") "" Then
Range("C16") = "L:331+P:"
End If
If Range("E16") "" Then
Range("M16") = 8
End If
If Range("E16") "" And Range("G16") "" Then
Range("M16") = 16
End If
'Linie 332+333
If Range("E17") "" Then
Range("C17") = "L:332+P:+333+P:"
End If
If Range("G17") "" Then
Range("C17") = "L:332+P:+333+P:"
End If
If Range("E17") "" Then
Range("N17") = 6
End If
If Range("E17") "" Then
Range("O17") = 2
End If
'Linie 332
If Range("E18") "" Then
Range("C18") = "L:332+P:"
End If
If Range("G18") "" Then
Range("C18") = "L:332+P:"
End If
If Range("E18") "" Then
Range("N18") = 8
End If
If Range("E18") "" And Range("G18") "" Then
Range("N18") = 16
End If
'Linie 333
If Range("E19") "" Then
Range("C19") = "L:332+P:"
End If
If Range("G19") "" Then
Range("C19") = "L:332+P:"
End If
If Range("E19") "" Then
Range("O19") = 8
End If
If Range("E19") "" And Range("G19") "" Then
Range("O19") = 16
End If
'Reserve1
If Range("C21") "" Then
Range("P21") = 8
End If
If Range("C22") "" Then
Range("P22") = 8
End If
'Reserve3
If Range("C23") "" Then
Range("P23") = 8
End If
'Reserve4
If Range("C24") "" Then
Range("P24") = 8
End If
'Reserve5
If Range("C25") "" Then
Range("P25") = 8
End If
'QS Anlernen
If Range("E28") "" Then
Range("C28") = "QS Anlernen:"
End If
If Range("E28") "" Then
Range("I28") = 1
End If
If Range("E28") "" Then
Range("J28") = 2
End If
If Range("E28") "" Then
Range("K28") = 1
End If
If Range("E28") "" Then
Range("L28") = 1
End If
If Range("E28") "" Then
Range("M28") = 1
End If
If Range("E28") "" Then
Range("N28") = 1
End If
If Range("E28") "" Then
Range("O28") = 1
End If
'Schrumpfer Anlernen
If Range("E33") "" Then
Range("C33") = "Schrumpfer Anl.:"
End If
If Range("E33") "" Then
Range("K33") = 0.5
End If
If Range("E33") "" Then
Range("L33") = 0.5
End If
If Range("E33") "" Then
Range("N33") = 0.5
End If
If Range("E33") "" Then
Range("O33") = 0.5
End If
If Range("E33") "" Then
Range("K33") = 0.5
End If
If Range("E33") "" Then
Range("S33") = "MSK"
End If
If Range("E33") "" Then
Range("V33") = 6
End If
''Call CopySchichtliste
If MsgBox("Soll gedruckt werden ?", vbYesNo + vbQuestion, "Druckabfrage ?") = vbNo Then
Exit Sub
End If
Worksheets("Personaldruck").PrintOut Copies:=1, Collate:=True
Cancel = True
Worksheets("Personalbesetzung").Range("Y5").Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Private Function fncPersonal(sName As String, sTaetigkeit As String, _
Optional lZeile As Long) As Boolean
If sName = "" Or sTaetigkeit = "" Then Exit Function
With Sheets("Personalbesetzung")
Select Case sTaetigkeit
Case "311": fncPersonal = Eintragen(zeile:=10, sText:=sName)
Case "312": fncPersonal = Eintragen(zeile:=11, sText:=sName)
Case "321+322": fncPersonal = Eintragen(zeile:=12, sText:=sName)
Case "321": fncPersonal = Eintragen(zeile:=13, sText:=sName)
Case "322": fncPersonal = Eintragen(zeile:=14, sText:=sName)
Case "331+332": fncPersonal = Eintragen(zeile:=15, sText:=sName)
Case "331": fncPersonal = Eintragen(zeile:=16, sText:=sName)
Case "332+333": fncPersonal = Eintragen(zeile:=17, sText:=sName)
Case "L:332": fncPersonal = Eintragen(zeile:=18, sText:=sName)
Case "L:333": fncPersonal = Eintragen(zeile:=19, sText:=sName)
Case "Reserve"
lZeile = lZeile + 1
.Cells(lZeile, 3) = sName
Case ""
'do nothing
Case "QS Anlernen": .Cells(28, 5) = sName
'Case "Schrumpfer": .Cells(32, 5) = sName
Case "Schrumpfer Anlernen": .Cells(33, 5) = sName
Case Else
MsgBox "Für die Auswahl """ & sTaetigkeit _
& """ Fehlt noch eine Case-Zeile im Makro"
End Select
End With
End Function
Function Eintragen(ByVal zeile As Long, ByVal sText As String) As Boolean
'Name Eintragen für Maschine in Spalte E oder G
Dim lSpalte As Long
lSpalte = 5
With Sheets("Personalbesetzung")
If .Cells(zeile, lSpalte) = "" Then '1. Name für Maschine
.Cells(zeile, lSpalte) = sText
ElseIf .Cells(zeile, lSpalte + 2) = "" Then '2. Name für Maschine
.Cells(zeile, lSpalte + 2) = sText
Else
MsgBox "Für Linie """ & .Cells(zeile, 3) & """ soll als 3. Person """ _
& sText & " eingetragen werden." & vbLf & vbLf _
& "Bitte Eingabe korrigieren!", vbOKOnly + vbInformation, "Personalbesetzung ausfüllen"
Eintragen = True
End If
End With
End Function
Private Sub ComboBoxSortierer1_Change() 'Sortierer 1
Me.ComboBoxSortierer1_1.Visible = Len(Me.ComboBoxSortierer1)
Me.TextBoxSortierer1.Visible = Len(Me.ComboBoxSortierer1)
End Sub
Private Sub ComboBoxSortierer2_Change() 'Sortierer 2
Me.ComboBoxSortierer2_2.Visible = Len(Me.ComboBoxSortierer2)
Me.TextBoxSortierer2.Visible = Len(Me.ComboBoxSortierer2)
End Sub
Private Sub ComboBoxSortierer3_Change() 'Sortierer 3
Me.ComboBoxSortierer3_3.Visible = Len(Me.ComboBoxSortierer3)
Me.TextBoxSortierer3.Visible = Len(Me.ComboBoxSortierer3)
End Sub
Private Sub ComboBoxSortierer4_Change() 'Sortierer 4
Me.ComboBoxSortierer4_4.Visible = Len(Me.ComboBoxSortierer4)
Me.TextBoxSortierer4.Visible = Len(Me.ComboBoxSortierer4)
End Sub
Private Sub ComboBoxSortierer5_Change() 'Sortierer 5
Me.ComboBoxSortierer5_5.Visible = Len(Me.ComboBoxSortierer5)
Me.TextBoxSortierer5.Visible = Len(Me.ComboBoxSortierer5)
End Sub
Private Sub ComboBoxSortierer6_Change() 'Sortierer 6
Me.ComboBoxSortierer6_6.Visible = Len(Me.ComboBoxSortierer6)
Me.TextBoxSortierer6.Visible = Len(Me.ComboBoxSortierer6)
End Sub
Private Sub ComboBoxSortierer7_Change() 'Sortierer 7
Me.ComboBoxSortierer7_7.Visible = Len(Me.ComboBoxSortierer7)
Me.TextBoxSortierer7.Visible = Len(Me.ComboBoxSortierer7)
End Sub
Private Sub ComboBoxSortierer8_Change() 'Sortierer 8
Me.ComboBoxSortierer8_8.Visible = Len(Me.ComboBoxSortierer8)
Me.TextBoxSortierer8.Visible = Len(Me.ComboBoxSortierer8)
End Sub
Private Sub ComboBoxSortierer9_Change() 'Sortierer 9
Me.ComboBoxSortierer9_9.Visible = Len(Me.ComboBoxSortierer9)
Me.TextBoxSortierer9.Visible = Len(Me.ComboBoxSortierer9)
End Sub
Private Sub ComboBoxSortierer10_Change() 'Sortierer 10
Me.ComboBoxSortierer10_10.Visible = Len(Me.ComboBoxSortierer10)
Me.TextBoxSortierer10.Visible = Len(Me.ComboBoxSortierer10)
End Sub
Private Sub ComboBoxAnlernen1_Change() 'Anlernen 1
Me.ComboBoxAnlernen1_1.Visible = Len(Me.ComboBoxAnlernen1)
Me.TextBoxAnlernen1.Visible = Len(Me.ComboBoxAnlernen1)
End Sub
Private Sub ComboBoxAnlernen2_Change() 'Anlernen 2
Me.ComboBoxAnlernen2_2.Visible = Len(Me.ComboBoxAnlernen2)
Me.TextBoxAnlernen2.Visible = Len(Me.ComboBoxAnlernen2)
End Sub
Private Sub ComboBoxAnlernen3_Change() 'Anlernen 3
Me.ComboBoxAnlernen3_3.Visible = Len(Me.ComboBoxAnlernen3)
Me.TextBoxAnlernen3.Visible = Len(Me.ComboBoxAnlernen3)
End Sub
Private Sub ComboBoxFerialarbeiter1_Change() 'Ferialarbeiter 1
Me.ComboBoxFerialarbeiter1_1.Visible = Len(Me.ComboBoxFerialarbeiter1)
Me.TextBoxFerialarbeiter1.Visible = Len(Me.ComboBoxFerialarbeiter1)
End Sub
Private Sub ComboBoxFerialarbeiter2_Change() 'Ferialarbeiter 2
Me.ComboBoxFerialarbeiter2_2.Visible = Len(Me.ComboBoxFerialarbeiter2)
Me.TextBoxFerialarbeiter2.Visible = Len(Me.ComboBoxFerialarbeiter2)
End Sub
Private Sub ComboBoxFerialarbeiter3_Change() 'Ferialarbeiter 3
Me.ComboBoxFerialarbeiter3_3.Visible = Len(Me.ComboBoxFerialarbeiter3)
Me.TextBoxFerialarbeiter3.Visible = Len(Me.ComboBoxFerialarbeiter3)
End Sub
Private Sub ComboBoxZusätzliche_MA1_Change() 'Zusätzliche MA 1
Me.ComboBoxZusätzliche_MA1_1.Visible = Len(Me.ComboBoxZusätzliche_MA1)
End Sub
Private Sub ComboBoxZusätzliche_MA2_Change() 'Zusätzliche MA 2
Me.ComboBoxZusätzliche_MA2_2.Visible = Len(Me.ComboBoxZusätzliche_MA2)
End Sub
Private Sub ComboBoxZusätzliche_MA3_Change() 'Zusätzliche MA 3
Me.ComboBoxZusätzliche_MA3_3.Visible = Len(Me.ComboBoxZusätzliche_MA3)
End Sub
Private Sub ComboBoxRegie1_Change() 'Regie 1
Me.ComboBoxRegie1_1.Visible = Len(Me.ComboBoxRegie1)
End Sub
Private Sub ComboBoxRegie2_Change() 'Regie 2
Me.ComboBoxRegie2_2.Visible = Len(Me.ComboBoxRegie2)
End Sub
'Werte in den Comboboxen anzeigen
Private Sub UserForm_Activate()
With ComboBoxSchrumpfer
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxVorarbeiter
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxQS
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxSortierer1
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxSortierer2
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxSortierer3
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxSortierer4
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxSortierer5
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxSortierer6
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxSortierer7
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxSortierer8
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxSortierer9
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxSortierer10
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxAnlernen1
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxAnlernen2
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxAnlernen3
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxZusätzliche_MA1
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxZusätzliche_MA2
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxZusätzliche_MA3
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxRegie1
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxRegie2
.Clear
.List = UniqueList(Sheets("Jänner").Range("A3:A154"))
End With
With ComboBoxFerialarbeiter1
.Clear
.List = UniqueList(Sheets("Jänner").Range("A188:A202"))
End With
With ComboBoxFerialarbeiter2
.Clear
.List = UniqueList(Sheets("Jänner").Range("A188:A202"))
End With
With ComboBoxFerialarbeiter3
.Clear
.List = UniqueList(Sheets("Jänner").Range("A188:A202"))
End With
End Sub
'Werte von Sheets Jänner A3:A154 ohne Null anzeigen
Function UniqueList(Matrix As Range, Optional Sorted As Boolean = True) As Variant
Dim objDic As Object, rng As Range, varTmp() As Variant
Set objDic = CreateObject("Scripting.Dictionary")
For Each rng In Matrix
If rng.Value 0 Then objDic(rng.Value) = 0
Next
varTmp = objDic.keys
If Sorted Then QuickSort varTmp
UniqueList = varTmp
Set objDic = Nothing
End Function
'Werte von Sheets Jänner A3:A154 nach ABC sortieren
Private Sub QuickSort(data() As Variant, Optional UG, Optional OG)
Dim P1&, P2&, T1 As Variant, T2 As Variant
UG = IIf(IsMissing(UG), LBound(data), UG)
OG = IIf(IsMissing(OG), UBound(data), OG)
P1 = UG
P2 = OG
T1 = data((P1 + P2) / 2)
Do
Do While (data(P1) T1)
P2 = P2 - 1
Loop
If P1 P2)
If UG