Imports System.Globalization Imports System.Security.Authentication.ExtendedProtection Imports Microsoft.Office.Interop Public Class frmDienstplanVariabel Private isDrawn As Boolean = False Public niederlassung = "" Private blueBrush As New SolidBrush(Color.LightBlue) Private greenBrush As New SolidBrush(Color.LightGreen) Private f_black As New Font("Arial", 8) Private f_black_bold As New Font("Arial", 8, FontStyle.Bold) Private stift As New Pen(Color.Gray, 1) Private stift2 As New Pen(Color.LightGray, 2) Private scr_left As Integer = 200 Private scr_top As Integer = 50 Private isSplitschicht As Boolean = False Dim week() As String = {"SO", "MO", "DI", "MI", "DO", "FR", "SA"} Private SCHICHT = "ROT" Dim ADMIN As New cOptionenDAL Dim SQLDienst As New cDienstplan Dim ListMA As New List(Of cMAShort) Dim MA As New cDienstMA Dim DienstDetails As List(Of cDienstDetails) Dim DGV As New List(Of cDienstDGV) Dim BEN_SCHICHTEN As New List(Of usrCntlDienstWoche) Dim SCHICHTEN_ARTEN As New List(Of cDienstplanSchicht) Dim SETTINGS As cDienstSettings Dim aktDate As Date = Now Dim aktWoche As Integer = 0 Dim aktJahr As Integer = 1900 Dim aktMitarbeiterEintrag As String 'ID des Eintrages des aktuell ausgewählen MA Dim pf As New cProgramFunctions Dim usrCntlZeitenAendern1 As usrCntlZeitenAendern Dim markId As Integer = -1 Sub New() InitializeComponent() End Sub Sub New(niederlassung) ' Dieser Aufruf ist für den Designer erforderlich. InitializeComponent() Me.niederlassung = niederlassung ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. End Sub Sub fillCboQS() cboQSSpaet.Items.Clear() Dim ListMA As New List(Of cDienstMA) ListMA = SQLDienst.getAllDienstMA(niederlassung, CalendarWeek(aktWoche, aktJahr), " AND dstma_abteilung = 'QS' ") For Each m In ListMA cboQSSpaet.Items.Add(New VERAG_PROG_ALLGEMEIN.MyListItem(m.dstma_kuerzel, m.dstma_id)) Next End Sub Public Sub initDienstplan() Dim STD_LIST = cDienstMitarbAbweichendeWochenstunden.GET_STD_LIST(CalendarWeek(aktWoche, aktJahr)) pf.KWAbschluss(STD_LIST, niederlassung, aktJahr, aktWoche, SCHICHT) ' initDienstplan() If Panel6.Controls.Count > 0 Then DirectCast(Panel6.Controls(0), usrcntlDienstplanStunden).loaded = False DienstDetails = SQLDienst.getAllDienstDetails(niederlassung) fillCboQS() 'Button14.Visible = Not SQLDienst.existsEntryKWUeberstd(niederlassung, aktJahr, aktWoche) If Not SQLDienst.existsEntryKWUeberstd(niederlassung, aktJahr, aktWoche) Then Button14.Text = "Woche erneut abschließen" Else Button14.Text = "Woche abschließen" End If Dim datum As Date = CalendarWeek(aktWoche, aktJahr) Dim arrZoll1 As String() = {"dgvZoll1_Mo", "dgvZoll1_Di", "dgvZoll1_Mi", "dgvZoll1_Do", "dgvZoll1_Fr", "dgvZoll1_Sa", "dgvZoll1_So"} Dim arrZoll2 As String() = {"dgvZoll2_Mo", "dgvZoll2_Di", "dgvZoll2_Mi", "dgvZoll2_Do", "dgvZoll2_Fr", "dgvZoll2_Sa", "dgvZoll2_So"} Dim arrZollTag As String() = {"dgvZollTag_Mo", "dgvZollTag_Di", "dgvZollTag_Mi", "dgvZollTag_Do", "dgvZollTag_Fr", "dgvZollTag_Sa", "dgvZollTag_So"} Dim arrQS As String() = {"dgvQS_Mo", "dgvQS_Di", "dgvQS_Mi", "dgvQS_Do", "dgvQS_Fr", "dgvQS_Sa", "dgvQS_So"} Dim arrKS As String() = {"dgvKS_Mo", "dgvKS_Di", "dgvKS_Mi", "dgvKS_Do", "dgvKS_Fr", "dgvKS_Sa", "dgvKS_So"} Dim arrUrl As String() = {"dgvUrl_Mo", "dgvUrl_Di", "dgvUrl_Mi", "dgvUrl_Do", "dgvUrl_Fr", "dgvUrl_Sa", "dgvUrl_So"} Dim arrDR As String() = {"dgvDR_Mo", "dgvDR_Di", "dgvDR_Mi", "dgvDR_Do", "dgvDR_Fr", "dgvDR_Sa", "dgvDR_So"} Dim arrFrei As String() = {"dgvFrei_Mo", "dgvFrei_Di", "dgvFrei_Mi", "dgvFrei_Do", "dgvFrei_Fr", "dgvFrei_Sa", "dgvFrei_So"} Dim arrZA As String() = {"dgvZA_Mo", "dgvZA_Di", "dgvZA_Mi", "dgvZA_Do", "dgvZA_Fr", "dgvZA_Sa", "dgvZA_So"} DGV.Clear() Dim orderBy As String = " ORDER BY dstma_reihenfolge ASC, dstma_kuerzel ASC " Dim orderBy2 As String = " ORDER BY dstma_kuerzel ASC " ' Variable-Schichten: 'FlowLayoutPanel.Controls.Clear() ' Dim DTBenutzer As DataTable = ADMIN.AnzeigeTabelle(" SELECT * FROM [tblDienstplanEintraegeDetails] WHERE [dedet_niederlassung]='" & niederlassung & "' AND dedet_benutzerdefinierteSchicht=1 ") 'For Each r As DataRow In DTBenutzer.Rows For Each b In BEN_SCHICHTEN Dim SCHICHT As cDienstplanSchicht = b.SCHICHT 'Dim u As New usrCntlDienstWoche(b.SCHICHT) ' u.Height = (FlowLayoutPanel.Height - 5) * (SCHICHT.dedet_ProzentGrafik / 100) ' FlowLayoutPanel.Controls.Add(u) Dim schicht_Name = SCHICHT.dedet_abt If schicht_Name = "ZOLL1" Then schicht_Name = "ZOLL_VM" If schicht_Name = "ZOLL2" Then schicht_Name = "ZOLL_NM" Dim IsHauptsplitschicht = SCHICHT.dedet_Hauptsplitschicht datum = CalendarWeek(aktWoche, aktJahr) For i = 0 To 6 Dim andstr As String = " AND dstetr_datum='" & datum.ToShortDateString & "' AND dstetr_dstmaId=dstma_id AND mit_id=dstma_mitId " andstr &= " AND dstetr_niederlassung='" & niederlassung & "'" Dim dgvTmp As DataGridView = getDGV("dgv_" & datum.ToString("ddd").Replace(".", ""), b) If dgvTmp IsNot Nothing Then dgvTmp.DataSource = SQLDienst.loadDGV("SELECT dstetr_id, dstma_kuerzel + ' '+ dstetr_info,dstma_id,dstma_arbvh, dstetr_von,dstetr_bis,dstma_stammSchicht, dstetr_info,dstma_reihenfolge, dstma_farbe,dstetr_pause, dstetr_splitschicht, dstetr_hauptsplitschicht FROM tblDienstplanEintraege,tblDienstMitarb,tblMitarbeiter WHERE (dstetr_art='" & schicht_Name & "') " & andstr & orderBy) DGV.Add(New cDienstDGV("dgv_" & datum.ToString("ddd").Replace(".", ""), datum, schicht_Name, b, IsHauptsplitschicht)) ', getDienstDetails("ZOLL1", "von"), getDienstDetails("ZOLL1", "bis"))) End If datum = datum.AddDays(1) Next Next ' Standard-Schichten: datum = CalendarWeek(aktWoche, aktJahr) For i = 0 To 6 Dim andstr As String = " AND dstetr_datum='" & datum.ToShortDateString & "' AND dstetr_dstmaId=dstma_id AND mit_id=dstma_mitId " andstr &= " AND (mit_gekuendigt =0 OR mit_kuendigungsdatum>=dstetr_datum) AND dstetr_niederlassung='" & niederlassung & "'" getDGV(arrUrl(i), Nothing).DataSource = SQLDienst.loadDGV("SELECT dstetr_id, dstma_kuerzel + ' '+ dstetr_info,dstma_id,dstma_arbvh, dstetr_von,dstetr_bis,dstma_stammSchicht, dstetr_info,dstma_reihenfolge, dstma_farbe,dstetr_pause, dstetr_splitschicht, dstetr_hauptsplitschicht FROM tblDienstplanEintraege,tblDienstMitarb,tblMitarbeiter WHERE dstetr_art='URL'" & andstr & orderBy2) DGV.Add(New cDienstDGV(arrUrl(i), datum, "URL", Nothing)) ', getDienstDetails("URL", "von"), getDienstDetails("URL", "bis"))) getDGV(arrKS(i), Nothing).DataSource = SQLDienst.loadDGV("SELECT dstetr_id, dstma_kuerzel + ' '+ dstetr_info,dstma_id,dstma_arbvh, dstetr_von,dstetr_bis,dstma_stammSchicht, dstetr_info,dstma_reihenfolge, dstma_farbe,dstetr_pause, dstetr_splitschicht, dstetr_hauptsplitschicht FROM tblDienstplanEintraege,tblDienstMitarb,tblMitarbeiter WHERE dstetr_art='KS'" & andstr & orderBy2) DGV.Add(New cDienstDGV(arrKS(i), datum, "KS", Nothing)) ', getDienstDetails("KS", "von"), getDienstDetails("KS", "bis"))) getDGV(arrDR(i), Nothing).DataSource = SQLDienst.loadDGV("SELECT dstetr_id, dstma_kuerzel + ' '+ dstetr_info,dstma_id,dstma_arbvh, dstetr_von,dstetr_bis,dstma_stammSchicht, dstetr_info,dstma_reihenfolge, dstma_farbe,dstetr_pause, dstetr_splitschicht, dstetr_hauptsplitschicht FROM tblDienstplanEintraege,tblDienstMitarb,tblMitarbeiter WHERE (dstetr_art='DR' OR dstetr_art='BS')" & andstr & orderBy2) DGV.Add(New cDienstDGV(arrDR(i), datum, "DR", Nothing)) ', getDienstDetails("DR", "von"), getDienstDetails("DR", "bis"))) getDGV(arrFrei(i), Nothing).DataSource = SQLDienst.loadDGV("SELECT dstetr_id, dstma_kuerzel + ' '+ dstetr_info,dstma_id,dstma_arbvh, dstetr_von,dstetr_bis,dstma_stammSchicht, dstetr_info,dstma_reihenfolge, dstma_farbe,dstetr_pause, dstetr_splitschicht, dstetr_hauptsplitschicht FROM tblDienstplanEintraege,tblDienstMitarb,tblMitarbeiter WHERE dstetr_art='FREI'" & andstr & orderBy2) DGV.Add(New cDienstDGV(arrFrei(i), datum, "FREI", Nothing)) ', getDienstDetails("FREI", "von"), getDienstDetails("FREI", "bis"))) getDGV(arrZA(i), Nothing).DataSource = SQLDienst.loadDGV("SELECT dstetr_id, dstma_kuerzel + ' '+ dstetr_info,dstma_id,dstma_arbvh, dstetr_von,dstetr_bis,dstma_stammSchicht, dstetr_info,dstma_reihenfolge, dstma_farbe,dstetr_pause, dstetr_splitschicht, dstetr_hauptsplitschicht FROM tblDienstplanEintraege,tblDienstMitarb,tblMitarbeiter WHERE dstetr_art='ZA'" & andstr & orderBy2) DGV.Add(New cDienstDGV(arrZA(i), datum, "ZA", Nothing)) ', getDienstDetails("ZA", "von"), getDienstDetails("ZA", "bis"))) datum = datum.AddDays(1) Next ' MsgBox("t5") initStdMa() clearAllSelection() initDGVColors() initAusslastung() UsrCntlAuswertungAuslastungMA1.init(CalendarWeek(aktWoche, aktJahr), niederlassung) If tbcntr.SelectedTab Is tbTagesverteilung Then UsrCntlAuswertungAuslastungMA1.Refresh() End If If tbcntr.SelectedTab Is tbAuswertung Then initDetails(True) End If If markId > 0 Then markNamesinDGV(markId) End If If Panel6.Controls.Count > 0 Then DirectCast(Panel6.Controls(0), usrcntlDienstplanStunden).loaded = True End Sub Sub initStdMa() Dim usrcntl As New usrcntlDienstplanStunden(aktWoche, aktJahr, niederlassung, SCHICHT) ' usrcntl.initStdMa() usrcntl.Dock = DockStyle.Fill Panel6.Controls.Clear() If Not VERAG_PROG_ALLGEMEIN.cBerechtignunen.CHECK_BERECHTIGUNG_bool("DP_Bearbeiten", Me) Then usrcntl.btnCounterUest.Enabled = False End If Panel6.Controls.Add(usrcntl) AddHandler usrcntl.NAME_CHANGED, Sub(id) markNamesinDGV(id) End Sub DirectCast(Panel6.Controls(0), usrcntlDienstplanStunden).initStdMa() End Sub Private Sub frmDienstplan_KeyPress(sender As Object, e As KeyPressEventArgs) Handles Me.KeyPress If e.KeyChar = Microsoft.VisualBasic.ChrW(Keys.PageDown) Then Button7.PerformClick() End If If e.KeyChar = Microsoft.VisualBasic.ChrW(Keys.PageUp) Then Button6.PerformClick() End If End Sub Sub initAnzahl() ' lblAnzZoll1_Mo.Text = dgvZoll1_Mo.RowCount ' lblAnzZoll1_Di.Text = dgvZoll1_Di.RowCount ' lblAnzZoll1_Mi.Text = dgvZoll1_Mi.RowCount ' lblAnzZoll1_Do.Text = dgvZoll1_Do.RowCount ' lblAnzZoll1_Fr.Text = dgvZoll1_Fr.RowCount ' lblAnzZoll1_Sa.Text = dgvZoll1_Sa.RowCount ' lblAnzZoll1_So.Text = dgvZoll1_So.RowCount ' lblAnzZoll2_Mo.Text = dgvZoll2_Mo.RowCount ' lblAnzZoll2_Di.Text = dgvZoll2_Di.RowCount ' lblAnzZoll2_Mi.Text = dgvZoll2_Mi.RowCount ' lblAnzZoll2_Do.Text = dgvZoll2_Do.RowCount ' lblAnzZoll2_Fr.Text = dgvZoll2_Fr.RowCount ' lblAnzZoll2_Sa.Text = dgvZoll2_Sa.RowCount ' lblAnzZoll2_So.Text = dgvZoll2_So.RowCount 'lblAnzZollTag_Mo.Text = dgvZollTag_Mo.RowCount 'lblAnzZollTag_Di.Text = dgvZollTag_Di.RowCount 'lblAnzZollTag_Mi.Text = dgvZollTag_Mi.RowCount 'lblAnzZollTag_Do.Text = dgvZollTag_Do.RowCount 'lblAnzZollTag_Fr.Text = dgvZollTag_Fr.RowCount 'lblAnzZollTag_Sa.Text = dgvZollTag_Sa.RowCount 'lblAnzZollTag_So.Text = dgvZollTag_So.RowCount ' lblAnzQS_Mo.Text = dgvQS_Mo.RowCount ' lblAnzQS_Di.Text = dgvQS_Di.RowCount ' lblAnzQS_Mi.Text = dgvQS_Mi.RowCount ' lblAnzQS_Do.Text = dgvQS_Do.RowCount ' lblAnzQS_Fr.Text = dgvQS_Fr.RowCount ' lblAnzQS_Sa.Text = dgvQS_Sa.RowCount ' lblAnzQS_So.Text = dgvQS_So.RowCount End Sub Sub initAusslastung() Dim maxMaZoll As Integer = 18 Dim maxMaQS As Integer = 11 For Each b In BEN_SCHICHTEN b.initAnzahl() Next ' lblAuslastMaZoll_Mo.Text = CInt((dgvZoll1_Mo.RowCount + dgvZoll2_Mo.RowCount + dgvZollTag_Mo.RowCount) / (maxMaZoll / 100)) & " %" ' lblAuslastMaZoll_Di.Text = CInt((dgvZoll1_Di.RowCount + dgvZoll2_Di.RowCount + dgvZollTag_Di.RowCount) / (maxMaZoll / 100)) & " %" ' lblAuslastMaZoll_Mi.Text = CInt((dgvZoll1_Mi.RowCount + dgvZoll2_Mi.RowCount + dgvZollTag_Mi.RowCount) / (maxMaZoll / 100)) & " %" ' lblAuslastMaZoll_Do.Text = CInt((dgvZoll1_Do.RowCount + dgvZoll2_Do.RowCount + dgvZollTag_Do.RowCount) / (maxMaZoll / 100)) & " %" 'lblAuslastMaZoll_Fr.Text = CInt((dgvZoll1_Fr.RowCount + dgvZoll2_Fr.RowCount + dgvZollTag_Fr.RowCount) / (maxMaZoll / 100)) & " %" 'lblAuslastMaZoll_Sa.Text = CInt((dgvZoll1_Sa.RowCount + dgvZoll2_Sa.RowCount + dgvZollTag_Sa.RowCount) / (maxMaZoll / 100)) & " %" 'lblAuslastMaZoll_So.Text = CInt((dgvZoll1_So.RowCount + dgvZoll2_So.RowCount + dgvZollTag_So.RowCount) / (maxMaZoll / 100)) & " %" 'lblAuslastMaQS_Mo.Text = CInt(dgvQS_Mo.RowCount / (maxMaQS / 100)) & " %" 'lblAuslastMaQS_Di.Text = CInt(dgvQS_Di.RowCount / (maxMaQS / 100)) & " %" 'lblAuslastMaQS_Mi.Text = CInt(dgvQS_Mi.RowCount / (maxMaQS / 100)) & " %" ' lblAuslastMaQS_Do.Text = CInt(dgvQS_Do.RowCount / (maxMaQS / 100)) & " %" ' lblAuslastMaQS_Fr.Text = CInt(dgvQS_Fr.RowCount / (maxMaQS / 100)) & " %" ' lblAuslastMaQS_Sa.Text = CInt(dgvQS_Sa.RowCount / (maxMaQS / 100)) & " %" ' lblAuslastMaQS_So.Text = CInt(dgvQS_So.RowCount / (maxMaQS / 100)) & " %" End Sub ' Function getDGV(s) As DataGridView ' Return DirectCast(Me.Controls.Find(s, True)(0), DataGridView) ' End Function Function getDGV(s As String, u As usrCntlDienstWoche) As DataGridView Try s = s.Replace(".", "") If u IsNot Nothing AndAlso u.Controls.Count > 0 AndAlso u.Controls.Find(s, True).Count > 0 Then Return DirectCast(u.Controls.Find(s, True)(0), DataGridView) Return DirectCast(SplitContainer.Panel2.Controls.Find(s, True)(0), DataGridView) If False Then If u IsNot Nothing Then For Each d In u.Panel3.Controls If d.name = s Then Return d Next End If For Each d In TabPage4.Controls If d.name = s Then Return d Next Return Nothing Try Catch ex As Exception Return Nothing End Try End If Catch ex As Exception MsgBox("ERRDP 3: " & ex.Message & ex.StackTrace) Return Nothing End Try End Function Sub initWeekInfo() Dim dStart As Date = CalendarWeek(aktWoche, aktJahr) ' Label1.Text = dStart & " - " & dStart.AddDays(6) lblKW.Text = "KW " & aktWoche If EvenNumber() = False Then For Each b In BEN_SCHICHTEN If b.SCHICHT.dedet_bgAlternativeFarbe IsNot Nothing Then b.Panel3.BackColor = ColorTranslator.FromHtml(b.SCHICHT.dedet_bgAlternativeFarbe) Else b.Panel3.BackColor = Color.Firebrick End If Next 'Panel3.BackColor = Col0or.Firebrick 'Label12.ForeColor = Color.White 'Label15.ForeColor = Color.White SCHICHT = "ROT" Else For Each b In BEN_SCHICHTEN If b.SCHICHT.dedet_bgAlternativeFarbe IsNot Nothing Then b.Panel3.BackColor = ColorTranslator.FromHtml(b.SCHICHT.dedet_bgAlternativeFarbe) Else b.Panel3.BackColor = System.Drawing.Color.FromArgb(0, 60, 120) End If Next 'Panel3.BackColor = System.Drawing.Color.FromArgb(0, 60, 120) 'Label12.ForeColor = Color.White 'Label15.ForeColor = Color.White SCHICHT = "BLAU" End If If EvenNumber2() = False Then SCHICHT &= "1" Else SCHICHT &= "2" End If Dim datum As Date = dStart For i = 0 To 6 Select Case week(datum.DayOfWeek) Case "MO" : lblMo.Text = week(datum.DayOfWeek) & " " & datum.ToShortDateString Case "DI" : lblDi.Text = week(datum.DayOfWeek) & " " & datum.ToShortDateString Case "MI" : lblMi.Text = week(datum.DayOfWeek) & " " & datum.ToShortDateString Case "DO" : lblDo.Text = week(datum.DayOfWeek) & " " & datum.ToShortDateString Case "FR" : lblFr.Text = week(datum.DayOfWeek) & " " & datum.ToShortDateString Case "SA" : lblSa.Text = week(datum.DayOfWeek) & " " & datum.ToShortDateString Case "SO" : lblSo.Text = week(datum.DayOfWeek) & " " & datum.ToShortDateString End Select datum = datum.AddDays(1) Next End Sub Public Function EvenNumber() As Boolean Dim RefDate As Date = CDate("01.08.2015") Dim wD As Long = DateDiff(DateInterval.Weekday, aktDate, RefDate) EvenNumber = (wD And 1&) = 0& End Function Public Function EvenNumber2() As Boolean Dim RefDate As Date = CDate("01.08.2015") Dim wD As Long = DateDiff(DateInterval.Weekday, aktDate, RefDate) EvenNumber2 = (wD And 2&) = 0& End Function Private Sub frmDienstplan_Load(sender As Object, e As EventArgs) Handles Me.Load Me.Cursor = Cursors.WaitCursor SETTINGS = New cDienstSettings(niederlassung) setButtonTooltip(Button4) setButtonTooltip(Button3) setButtonTooltip(Button16) setButtonTooltip(Button13) setButtonTooltip(Button5) setButtonTooltip(Button10) setButtonTooltip(Button12) setButtonTooltip(Button15) usrCntlZeitenAendern1 = New usrCntlZeitenAendern usrCntlZeitenAendern1.Visible = False Panel1.Controls.Add(usrCntlZeitenAendern1) usrCntlZeitenAendern1.BringToFront() aktWoche = DateToWeek(aktDate).Substring(4, 2) aktJahr = DateToWeek(aktDate).Substring(0, 4) txtKWYear.Text = aktJahr ' For Each c In Panel1.Controls 'If TypeOf c Is DataGridView Then 'DirectCast(c, DataGridView).RowTemplate.Height = 15 ' End If ' Next ' For Each c In Panel3.Controls 'If TypeOf c Is DataGridView Then 'DirectCast(c, DataGridView).RowTemplate.Height = 15 ' End If ' Next ' For Each c In Panel4.Controls ' If TypeOf c Is DataGridView Then 'DirectCast(c, DataGridView).RowTemplate.Height = 15 ' End If ' Next FlowLayoutPanel.Controls.Clear() Dim DTBenutzer As DataTable = ADMIN.AnzeigeTabelle(" SELECT * FROM [tblDienstplanEintraegeDetails] WHERE [dedet_niederlassung]='" & niederlassung & "' AND dedet_benutzerdefinierteSchicht=1 AND dedet_aktiv=1 ORDER BY dedet_reihenfolge") For Each r As DataRow In DTBenutzer.Rows Dim SCHICHT As New cDienstplanSchicht(r("dedet_id")) Dim u As New usrCntlDienstWoche(SCHICHT, SETTINGS) If True Then 'SCHICHT.dedet_Splitschicht = False Then 'Splitschichten nicht im DGV anzeigen u.Height = (FlowLayoutPanel.Height - 5) * (SCHICHT.dedet_ProzentGrafik / 100) FlowLayoutPanel.Controls.Add(u) 'MsgBox(SCHICHT.dedet_info) End If Dim schicht_Name = SCHICHT.dedet_abt If schicht_Name = "ZOLL1" Then schicht_Name = "ZOLL_VM" If schicht_Name = "ZOLL2" Then schicht_Name = "ZOLL_NM" u.schicht_name = schicht_Name BEN_SCHICHTEN.Add(u) SCHICHTEN_ARTEN.Add(SCHICHT) Next initWeekInfo() initDienstplan() initDGVVerhalten() 'ConetxtMenü für verschieben aktivieren Dim i As Integer = 0 For Each s In BEN_SCHICHTEN Dim menu1 As ToolStripMenuItem Dim menuGanzeWoche As ToolStripMenuItem Dim splitSchichten As ToolStripMenuItem If s.SCHICHT.dedet_Splitschicht = False Then menu1 = New ToolStripMenuItem() With {.Text = "--> " & s.SCHICHT.dedet_info, .Name = "cti_" & s.schicht_name, .Font = New Font(Me.Font.FontFamily, Me.Font.Size, FontStyle.Bold)} AddHandler menu1.Click, AddressOf Schicht2ToolStripMenuItem_Click ctxtDgv.Items.Insert(i, menu1) menuGanzeWoche = New ToolStripMenuItem() With {.Text = "--> " & s.SCHICHT.dedet_info, .Name = "cti_" & s.schicht_name, .Font = New Font(Font.FontFamily, Font.Size, FontStyle.Bold)} AddHandler menuGanzeWoche.Click, AddressOf GanzeWocheToolStripMenuItem_Click GanzeWocheToolStripMenuItem.DropDownItems.Add(menuGanzeWoche) Else splitSchichten = New ToolStripMenuItem() With {.Text = "--> " & s.SCHICHT.dedet_info, .Name = "cti_" & s.schicht_name, .Font = New Font(Me.Font.FontFamily, Me.Font.Size, FontStyle.Bold)} AddHandler splitSchichten.Click, AddressOf ToolStripMenuSplitschicht_Click ToolStripMenuSplitschicht.DropDownItems.Add(splitSchichten) End If i += 1 Next 'EINTRAG BEARBEITEN AddHandler usrCntlZeitenAendern1.SAVE, Sub() Me.Cursor = Cursors.WaitCursor Try If usrCntlZeitenAendern1.txtPause.Text.Contains(",") And Not usrCntlZeitenAendern1.txtPause.Text.Contains(",5") Then Throw New Exception If Not IsNumeric(usrCntlZeitenAendern1.txtPause.Text) Then Throw New Exception If usrCntlZeitenAendern1.txtPause.Text > 3 Or usrCntlZeitenAendern1.txtPause.Text < 0 Then MsgBox("Die Pause darf nicht größer als 3 Stunden und nicht kleiner als 0 sein!") : Throw New Exception If usrCntlZeitenAendern1.cbxChangeForWo.Checked Then 'für ganze Woche Try Dim montag As Date = CalendarWeek(aktWoche, aktJahr) Dim maid = SQLDienst.getMaIdByEtrId(aktMitarbeiterEintrag) If maid <> "" Then SQLDienst.updateDienstEintragVonBisBemWOCHEChangeByMitId(CInt(maid), montag, montag.AddDays(4), usrCntlZeitenAendern1.txtVon.Text, usrCntlZeitenAendern1.txtBis.Text, usrCntlZeitenAendern1.txtBemerkung.Text, usrCntlZeitenAendern1.txtPause.Text, niederlassung) End If Catch ex As Exception MsgBox("ERRDP 4: " & ex.Message & ex.StackTrace) End Try Else 'für diesen Eintrag SQLDienst.updateDienstEintragArtBemerkungChange(aktMitarbeiterEintrag, usrCntlZeitenAendern1.txtVon.Text, usrCntlZeitenAendern1.txtBis.Text, usrCntlZeitenAendern1.txtBemerkung.Text, usrCntlZeitenAendern1.txtPause.Text) End If usrCntlZeitenAendern1.cbxChangeForWo.Checked = False Catch ex As Exception MsgBox("Fehler beim Speichern des Eintrages.") End Try 'Where dsteintr_id=aktMitarbeiterEintrag usrCntlZeitenAendern1.Visible = False initDienstplan() setDetails(entryId_TMP) Me.Cursor = Cursors.Default End Sub 'SCHICHT LÖCSHEN AddHandler SchichtLöcshenToolStripMenuItem.Click, AddressOf SchichtLöcshenToolStripMenuItem_Click initAusslastung() If Not VERAG_PROG_ALLGEMEIN.cBerechtignunen.CHECK_BERECHTIGUNG_bool("DP_Bearbeiten", Me) Then pnlOptions.Enabled = False Button18.Enabled = False End If Me.Cursor = Cursors.Default End Sub Sub setButtonTooltip(b As Control) Dim t As New System.Windows.Forms.ToolTip() t.SetToolTip(b, b.Tag) End Sub Sub initDGVVerhalten() Try For Each datagridview As cDienstDGV In DGV Dim d As DataGridView = getDGV(datagridview.dgvName, datagridview.USRCNTL) 'If datagridview.USRCNTL Is Nothing Then ' AddHandler d.LostFocus, AddressOf remHandlerKey 'Else ' If datagridview.USRCNTL.SCHICHT.dedet_Splitschicht <> True Then ' AddHandler d.LostFocus, AddressOf remHandlerKey ' End If 'End If AddHandler d.LostFocus, AddressOf remHandlerKey AddHandler d.MouseDown, AddressOf handleDGVContextMenue AddHandler d.MouseClick, AddressOf handleDGVClick AddHandler d.CellDoubleClick, AddressOf handleDGVDoubleClick setDGV(d) ' AddHandler d.DragDrop, AddressOf dgv_DragDrop ' AddHandler d.DragEnter, AddressOf dgv_DragEnter AddHandler d.Leave, AddressOf dgv_clearSelection 'd.Columns(1).Width = d.Width - 20 Next Catch ex As Exception MsgBox("initDGVVerhalten-Error: " & ex.Message) End Try End Sub Sub initDGVColors() Try For Each datagridview As cDienstDGV In DGV Dim d As DataGridView = getDGV(datagridview.dgvName, datagridview.USRCNTL) For Each r As DataGridViewRow In d.Rows ' MsgBox(r.Cells(1).Value) If r.Cells(6).Value = "ZOLL1" Then r.Cells(1).Style.BackColor = System.Drawing.Color.FromArgb(255, 230, 230) If r.Cells(6).Value = "ZOLL2" Then r.Cells(1).Style.BackColor = System.Drawing.Color.FromArgb(230, 255, 255) If r.Cells(6).Value = "QS" Then r.Cells(1).Style.BackColor = System.Drawing.Color.FromArgb(255, 255, 230) If r.Cells(6).Value = "" Then r.Cells(1).Style.BackColor = System.Drawing.Color.FromArgb(255, 255, 255) Next Next Catch ex As Exception MsgBox("initDGVVerhalten-Error: " & ex.Message) End Try End Sub Dim f_zeit As Font = New Font(Me.Font.FontFamily, 7) Sub setDGV(dgv As DataGridView) With dgv .AllowUserToAddRows = False .AllowUserToDeleteRows = False .AllowUserToOrderColumns = False .AllowUserToResizeColumns = False .AllowUserToResizeRows = False .RowHeadersVisible = False .ColumnHeadersVisible = False '.RowTemplate.Height = 15 If .ColumnCount > 0 Then .Columns(0).Visible = False If .ColumnCount > 2 Then For i = 2 To .ColumnCount - 1 .Columns(i).Visible = False Next End If .Columns(1).AutoSizeMode = DataGridViewAutoSizeColumnMode.Fill If SETTINGS.dpset_showTime Then .Columns("dstetr_von").Visible = True .Columns("dstetr_bis").Visible = True .Columns("dstetr_von").Width = 35 .Columns("dstetr_bis").Width = 35 .Columns("dstetr_von").DefaultCellStyle.Font = f_zeit .Columns("dstetr_bis").DefaultCellStyle.Font = f_zeit .Columns(1).AutoSizeMode = DataGridViewAutoSizeColumnMode.Fill End If End With initDGV(dgv) End Sub Sub initDGV(dgv As DataGridView) For Each r As DataGridViewRow In dgv.Rows If r.Cells(3).Value = "TZ" Then ' r.Cells(1).Style.ForeColor = Color.Blue r.Cells(1).Style.ForeColor = ColorTranslator.FromHtml(r.Cells(9).Value) End If Next End Sub Sub clearAllSelection() markId = -1 For Each datagridview As cDienstDGV In DGV Dim dgv As DataGridView = getDGV(datagridview.dgvName, datagridview.USRCNTL) dgv.ClearSelection() initDGV(dgv) Next TextBox1.Text = "" TextBox2.Text = "" TextBox3.Text = "" TextBox4.Text = "" Button9.Visible = False Label32.Text = "-" lblMAInfo.Text = "-" aktMitarbeiterEintrag = "" End Sub Function getDienstDetails(abt, s, woTag) As String For Each d In DienstDetails If d.dedet_abt = abt And d.dedet_woTag = woTag Then If s = "von" Then Return d.dedet_von If s = "bis" Then Return d.dedet_bis End If Next Return "" End Function Private Sub PaintLeft(e As PaintEventArgs) ' If Not isDrawn Then isDrawn = True Dim z As Graphics z = e.Graphics z.Clear(Color.White) ' Dim f_red As New Font("Arial", 8) Dim myDT As DateTime = DateTime.Now Dim myCal As Calendar = CultureInfo.InvariantCulture.Calendar Dim lastMonth As DateTime = myCal.AddMonths(myDT, -1) Dim nextMonth As DateTime = myCal.AddMonths(myDT, 1) Dim dayOWeak As Array = {"So", "Mo", "Di", "Mi", "Do", "Fr", "Sa"} Dim monthOYear As Array = {"Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", "September", "Oktober", "November", "Dezember"} Dim Mitarbeiter As Array = {"Luxbauer Johann", "Siener Josef", "Luxbauer Andreas"} Dim format As New StringFormat(StringFormatFlags.DirectionRightToLeft) Dim cnt_mitarb As Integer = 0 For Each m In Mitarbeiter z.DrawString(m, f_black, Brushes.Black, New Rectangle(20, scr_top + 5 + (cnt_mitarb * 20), 160, 20), format) cnt_mitarb += 1 Next z.DrawString("", f_black, Brushes.Black, New Rectangle(20, scr_top + 25, 160, 20), format) End Sub Public Function DateToWeek(ByVal dDate As Date) As String ' Startdatum der ersten Kalenderwoche des Jahres und Folgejahres berechnen Dim dThisYear As Date = CalendarWeek(1, dDate.Year) Dim dNextYear As Date = CalendarWeek(1, dDate.Year + 1) ' Prüfen, ob Datum zur ersten Woche des Folgejahres gehört If dDate >= dNextYear Then ' Rückgabe: KW 1 des Folgejahres Return dDate.Year + 1 & "01" ElseIf dDate < dThisYear Then ' Falls das Datum noch zu einer KW aus dem letzten Jahr zählt Return dDate.Year - 1 & DatePart(DateInterval.WeekOfYear, New Date(dDate.Year - 1, 12, 28), FirstDayOfWeek.Monday, FirstWeekOfYear.FirstFourDays) Else ' KW = Differenz zum ersten Tag der ersten Woche Return dDate.Year & Format$(dDate.Subtract(dThisYear).Days \ 7 + 1, "00") End If End Function Public Shared Function CalendarWeek(ByVal nWeek As Integer, ByVal nYear As Integer) As Date ' Wochentag des 4. Januar des Jahres ermitteln Dim dStart As New Date(nYear, 1, 4) Dim nDay As Integer = (dStart.DayOfWeek + 6) Mod 7 + 1 ' Beginn der 1. KW des Jahres Dim dFirst As Date = dStart.AddDays(1 - nDay) ' Gesuchte KW ermitteln Return dFirst.AddDays((nWeek - 1) * 7) End Function Private Sub PaintThis(e As PaintEventArgs) ' If Not isDrawn Then isDrawn = True Dim z As Graphics z = e.Graphics z.Clear(Color.White) ' Dim f_red As New Font("Arial", 8) Dim myDT As DateTime = DateTime.Now Dim myCal As Calendar = CultureInfo.InvariantCulture.Calendar Dim lastMonth As DateTime = myCal.AddMonths(myDT, -1) Dim nextMonth As DateTime = myCal.AddMonths(myDT, 1) Dim dayOWeak As Array = {"So", "Mo", "Di", "Mi", "Do", "Fr", "Sa"} Dim monthOYear As Array = {"Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", "September", "Oktober", "November", "Dezember"} ' Dim Mitarbeiter As Array = {"Luxbauer Johann", "Siener Josef", "Luxbauer Andreas"} ' Dim format As New StringFormat(StringFormatFlags.DirectionRightToLeft) ' Dim cnt_mitarb As Integer = 0 ' For Each m In Mitarbeiter 'z.DrawString(m, f_black, Brushes.Black, New Rectangle(20, scr_top + 5 + (cnt_mitarb * 20), 160, 20), Format) ' cnt_mitarb += 1 ' Next ' z.DrawString("", f_black, Brushes.Black, New Rectangle(20, scr_top + 25, 160, 20), Format) ' Dim lastMonth As DateTime = myCal.AddMonths(myDT, -1) Dim daysLastM As Integer = myCal.GetDaysInMonth(myCal.GetYear(lastMonth), myCal.GetMonth(lastMonth)) Dim daysThisM As Integer = myCal.GetDaysInMonth(myCal.GetYear(myDT), myCal.GetMonth(myDT)) Dim daysNextM As Integer = myCal.GetDaysInMonth(myCal.GetYear(nextMonth), myCal.GetMonth(nextMonth)) Dim greyBrush As New SolidBrush(Color.LightGray) z.FillRectangle(greyBrush, scr_left, scr_top - 50, (daysLastM + daysThisM + daysNextM) * 20, 20) z.DrawRectangle(stift, scr_left, scr_top - 50, daysLastM * 20, 20) 'Rahmen lastMonth z.DrawRectangle(stift, scr_left, scr_top - 50, (daysLastM + daysThisM) * 20, 20) 'Rahmen myCal z.DrawRectangle(stift, scr_left, scr_top - 50, (daysLastM + daysThisM + daysNextM) * 20, 20) 'Rahmen nextMonth z.DrawString(monthOYear(myCal.GetMonth(lastMonth) - 1), f_black, Brushes.Black, scr_left + daysLastM * 20 / 2, 2) z.DrawString(monthOYear(myCal.GetMonth(myDT) - 1), f_black_bold, Brushes.Black, scr_left + daysLastM * 20 + daysThisM * 20 / 2, 2) z.DrawString(monthOYear(myCal.GetMonth(nextMonth) - 1), f_black, Brushes.Black, scr_left + daysLastM * 20 + daysThisM * 20 + daysNextM * 20 / 2, 2) z.DrawRectangle(stift, 0, 0, 1800 + scr_left, 500 + scr_top) 'Rahmen z.FillRectangle(blueBrush, scr_left, scr_top - 30, 90 * 20, 30) Dim arrayDays(daysLastM + daysThisM + daysNextM) As Date Dim cnt As Integer = 0 'lastMonth zeichnen: For i As Integer = 0 To daysLastM - 1 z.DrawRectangle(stift, scr_left + i * 20, scr_top - 30, 20, 30) Dim b As Brush : Dim d As New DateTime(myCal.GetYear(lastMonth), myCal.GetMonth(lastMonth), i + 1) Dim dow As String = dayOWeak(myCal.GetDayOfWeek(d)) If dow = "Sa" Or dow = "So" Then b = Brushes.Red Else b = Brushes.Black z.DrawString(dow & vbNewLine & (i + 1), f_black, b, scr_left + i * 20, scr_top - 30) arrayDays(cnt) = d : cnt += 1 Next 'thisMonth zeichnen: For i As Integer = 0 To daysThisM - 1 z.DrawRectangle(stift, scr_left + i * 20, scr_top - 30, 20, 30) Dim b As Brush : Dim d As New DateTime(myCal.GetYear(myDT), myCal.GetMonth(myDT), i + 1) Dim dow As String = dayOWeak(myCal.GetDayOfWeek(d)) If dow = "Sa" Or dow = "So" Then b = Brushes.Red Else b = Brushes.Black Dim f As Font = f_black : If (i + 1) = myCal.GetDayOfMonth(myDT) Then f = f_black_bold z.DrawString(dow & vbNewLine & (i + 1), f, b, scr_left + (daysLastM + i) * 20, scr_top - 30) arrayDays(cnt) = d : cnt += 1 Next 'nextMonth zeichnen: For i As Integer = 0 To daysNextM - 1 z.DrawRectangle(stift, scr_left + i * 20, scr_top - 30, 20, 30) Dim b As Brush : Dim d As New DateTime(myCal.GetYear(nextMonth), myCal.GetMonth(nextMonth), i + 1) Dim dow As String = dayOWeak(myCal.GetDayOfWeek(d)) If dow = "Sa" Or dow = "So" Then b = Brushes.Red Else b = Brushes.Black z.DrawString(dow & vbNewLine & (i + 1), f_black, b, scr_left + (daysLastM + daysThisM + i) * 20, scr_top - 30) arrayDays(cnt) = d : cnt += 1 Next 'Raster zeichnen: For j As Integer = 0 To 20 For i As Integer = 0 To 90 z.DrawRectangle(stift, scr_left + i * 20, scr_top + j * 20, 20, 20) Next Next insertUrlaub(z, New DateTime(2015, 3, 15), New DateTime(2015, 4, 18), arrayDays, 0) insertUrlaub(z, New DateTime(2015, 4, 1), New DateTime(2015, 4, 10), arrayDays, 2) End Sub Private Sub PictureBox2_Click(sender As Object, e As EventArgs) Handles PictureBox2.Paint PaintThis(e) End Sub Private Sub PictureBox1_Click(sender As Object, e As EventArgs) Handles PictureBox1.Paint PaintLeft(e) End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Panel2.AutoScrollPosition = New Point(Panel2.HorizontalScroll.Value + 20, 0) End Sub Private Sub insertUrlaub(z As Graphics, startDate As DateTime, endDate As DateTime, arrayDays() As DateTime, Zeile As Integer) ' Dim startDate As New DateTime(2015, 3, 15) ' Dim endDate As New DateTime(2015, 4, 18) Dim x_start As Integer : Dim x_end As Integer If arrayDays(arrayDays.Count - 1) < endDate Then x_start = arrayDays.Count * 20 + 20 If arrayDays(0) > startDate Then x_start = 0 Dim diff As Integer For i As Integer = 0 To arrayDays.Count - 1 If arrayDays(i) = startDate Then x_start = i * 20 : diff = i If arrayDays(i) = endDate Then x_end = (i - diff) * 20 + 20 Next z.FillRectangle(greenBrush, scr_left + x_start, scr_top + (Zeile * 20), x_end, 20) z.DrawRectangle(stift, scr_left + x_start, scr_top + (Zeile * 20), x_end, 20) End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) Panel2.AutoScrollPosition = New Point(Panel2.HorizontalScroll.Value - 20, 0) End Sub Private Sub handleDGVClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Try Dim thisDgv As DataGridView = DirectCast(sender, DataGridView) Dim row As DataGridViewRow = thisDgv.CurrentRow setDetails(row.Cells("dstetr_id").Value) 'NULL??????? Catch ex As Exception clearAllSelection() End Try End Sub Private Sub handleDGVDoubleClick(ByVal sender As System.Object, ByVal e As DataGridViewCellEventArgs) Try Dim thisDgv As DataGridView = DirectCast(sender, DataGridView) Dim row As DataGridViewRow = thisDgv.CurrentRow setDetails2(usrCntlZeitenAendern1, row.Cells("dstetr_id").Value) 'NULL??????? ' If UsrCntlZeitenAendern1.txtVon.Text = "" Then Throw New Exception ' If UsrCntlZeitenAendern1.txtBis.Text = "" Then Throw New Exception usrCntlZeitenAendern1.lblVon.Text = "" usrCntlZeitenAendern1.lblBis.Text = "" Dim u_receiver As usrCntlDienstWoche = Nothing If thisDgv.Parent.Parent.GetType Is GetType(usrCntlDienstWoche) Then u_receiver = thisDgv.Parent.Parent Dim abt As String = getValuesDienstDGV(u_receiver, thisDgv.Name, "abt") Dim datum As Date = Date.Parse(getValuesDienstDGV(u_receiver, thisDgv.Name, "datum")) usrCntlZeitenAendern1.lblVon.Text = "(" & getDefaultTimeBySchicht(abt, "von", datum.ToString("ddd", New CultureInfo("de-DE")).Replace(".", "").Replace(".", "").ToUpper) & ")" usrCntlZeitenAendern1.lblBis.Text = "(" & getDefaultTimeBySchicht(abt, "bis", datum.ToString("ddd", New CultureInfo("de-DE")).Replace(".", "").Replace(".", "").ToUpper) & ")" 'UsrCntlZeitenAendern1.Location = If False Then ' Dim p As Point = Offset(sender, 0, 0) ' Dim p As Point = Offset(sender, Me.Left, Me.Top) ' Dim p = Offset(sender, 0, 0) Dim p = Windows.Forms.Cursor.Position If p.Y + (row.Index * row.Height) + usrCntlZeitenAendern1.Height > Me.Height Then ' MsgBox("hoch") p.Y += (row.Index * row.Height) - (2 * row.Height) p.Y -= usrCntlZeitenAendern1.Height Else p.Y += (row.Index * row.Height) End If ' p.Y += (row.Index * row.Height) usrCntlZeitenAendern1.Location = p End If Dim pt = New Point(thisDgv.Location.X, Panel1.PointToClient(Windows.Forms.Cursor.Position).Y + (row.Height * 0.75)) If pt.Y + usrCntlZeitenAendern1.Height > Me.Height Then pt.Y -= (usrCntlZeitenAendern1.Height + (row.Height * 1.5)) End If usrCntlZeitenAendern1.Location = pt usrCntlZeitenAendern1.Visible = True usrCntlZeitenAendern1.txtVon.Focus() Catch ex As Exception clearAllSelection() End Try End Sub Private Function Offset(ByRef controlObj As Control, ByVal x As Integer, ByVal y As Integer) As Point Dim pt As Point Dim parentObj As Control = controlObj.Parent Do While parentObj IsNot controlObj.FindForm x += parentObj.Location.X y += parentObj.Location.Y parentObj = parentObj.Parent Loop pt = PointToScreen(controlObj.Location) pt.Offset(x, y) Return pt End Function Private Function Offset2(ByRef controlObj As Control, ByVal x As Integer, ByVal y As Integer) As Point Do While controlObj IsNot controlObj.FindForm x += controlObj.Location.X y += controlObj.Location.Y controlObj = controlObj.Parent Loop Return New Point(x, y) End Function Dim cPF As New cProgramFunctions Public entryId_TMP As Integer = -1 Sub setDetails(entryId) Try entryId_TMP = entryId Dim row As DataRow = SQLDienst.loadDGV("SELECT dstetr_id, dstma_kuerzel + ' '+ dstetr_info as dstma_kuerzel,dstetr_info,dstma_id, dstetr_von,dstetr_bis,dstetr_art,dstetr_pause,dstetr_datum,dstma_mitId, dstetr_splitschicht, dstma_land FROM tblDienstplanEintraege, tblDienstMitarb, tblMitarbeiter WHERE dstetr_dstmaId=dstma_id AND mit_id=dstma_mitId AND dstetr_id='" & entryId & "'").Rows(0) TextBox1.Text = row("dstetr_von").ToString TextBox2.Text = row("dstetr_bis").ToString TextBox3.Text = row("dstetr_info").ToString TextBox4.Text = row("dstetr_pause").ToString isSplitschicht = row("dstetr_splitschicht").ToString Dim tatStd As Double = SQLDienst.getDstStunden(row("dstma_id").ToString, row("dstetr_datum").ToString, row("dstetr_datum").ToString, niederlassung, row("dstma_land").ToString) Dim schichtStd As Double = SQLDienst.getDstStunden(row("dstma_id").ToString, row("dstetr_datum").ToString, row("dstetr_datum").ToString, niederlassung, row("dstma_land").ToString, True) txtWoStd.Text = tatStd txtSchichtstd.Text = schichtStd txtSchichtstd.Visible = isSplitschicht Label1.Visible = isSplitschicht Label32.Text = CDate(row("dstetr_datum")).ToShortDateString lblMAInfo.Text = row("dstma_kuerzel").ToString & "(" & row("dstma_id").ToString & ")" aktMitarbeiterEintrag = row("dstetr_id").ToString If row("dstetr_art").ToString.Contains("NACHT") Then Button9.Visible = True markNamesinDGV(row("dstma_id").ToString) If Panel6.Controls.Count > 0 Then DirectCast(Panel6.Controls(0), usrcntlDienstplanStunden).markrow(row("dstma_id").ToString) End If ' For Each r In dgvStundenMa.Rows 'If r.Cells("dstma_id").value = thisDgv.CurrentRow.Cells(2).Value Then 'r.DefaultCellStyle.Font = New Font(thisDgv.Font, FontStyle.Bold) ' End If ' Next Catch ex As Exception MsgBox("ERRDP 5: " & ex.Message & ex.StackTrace) End Try End Sub Sub setDetails2(usr As usrCntlZeitenAendern, entryId As Integer) Try entryId_TMP = entryId Dim row As DataRow = SQLDienst.loadDGV("SELECT dstetr_id, dstma_kuerzel + ' '+ dstetr_info as dstma_kuerzel,dstetr_info,dstma_id, dstetr_von,dstetr_bis,dstetr_art,dstetr_pause,dstetr_datum FROM tblDienstplanEintraege, tblDienstMitarb, tblMitarbeiter WHERE dstetr_dstmaId=dstma_id AND mit_id=dstma_mitId AND dstetr_id='" & entryId & "'").Rows(0) usr.txtVon.Text = row("dstetr_von").ToString usr.txtBis.Text = row("dstetr_bis").ToString usr.txtBemerkung.Text = row("dstetr_info").ToString usr.txtPause.Text = row("dstetr_pause").ToString usr.Label32.Text = CDate(row("dstetr_datum")).ToShortDateString usr.lblMAInfo.Text = row("dstma_kuerzel").ToString aktMitarbeiterEintrag = row("dstetr_id").ToString If row("dstetr_art").ToString.Contains("NACHT") Then usr.Button9.Visible = True markNamesinDGV(row("dstma_id").ToString) If Panel6.Controls.Count > 0 Then DirectCast(Panel6.Controls(0), usrcntlDienstplanStunden).markrow(row("dstma_id").ToString) End If ' For Each r In dgvStundenMa.Rows 'If r.Cells("dstma_id").value = thisDgv.CurrentRow.Cells(2).Value Then 'r.DefaultCellStyle.Font = New Font(thisDgv.Font, FontStyle.Bold) ' End If ' Next Catch ex As Exception MsgBox("ERRDP 6: " & ex.Message & ex.StackTrace) End Try End Sub Private Sub handleDGVClick_OLD(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Exit Sub Try Dim thisDgv As DataGridView = DirectCast(sender, DataGridView) TextBox1.Text = thisDgv.CurrentRow.Cells(4).Value TextBox2.Text = thisDgv.CurrentRow.Cells(5).Value TextBox3.Text = thisDgv.CurrentRow.Cells(7).Value TextBox4.Text = thisDgv.CurrentRow.Cells("dstetr_pause").Value lblMAInfo.Text = thisDgv.CurrentRow.Cells(1).Value aktMitarbeiterEintrag = thisDgv.CurrentRow.Cells(0).Value If thisDgv.Name.Contains("QS") Then Button9.Visible = True markNamesinDGV(thisDgv.CurrentRow.Cells(2).Value) If Panel6.Controls.Count > 0 Then DirectCast(Panel6.Controls(0), usrcntlDienstplanStunden).markrow(thisDgv.CurrentRow.Cells(2).Value) End If Catch End Try End Sub Sub markNamesinDGV(id) markId = id ' clearBlackFont() If Panel6.Controls.Count > 0 Then DirectCast(Panel6.Controls(0), usrcntlDienstplanStunden).clearRowBg() DirectCast(Panel6.Controls(0), usrcntlDienstplanStunden).markrow(id) End If For Each d In DGV For Each r As DataGridViewRow In getDGV(d.dgvName, d.USRCNTL).Rows If r.Cells(2).Value = id Then 'r.Cells(1).Style.Font.Style = FontStyle.Bold Dim style As New DataGridViewCellStyle ' style.Font = New Font(dataGridView1.Font, FontStyle.Bold) r.DefaultCellStyle.Font = New Font(r.DataGridView.Font, FontStyle.Bold) Else r.DefaultCellStyle.Font = New Font(r.DataGridView.Font, FontStyle.Regular) End If Next Next End Sub Private Sub handleDGVContextMenue(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) 'Handles dgvZoll1_Mo.MouseDown If VERAG_PROG_ALLGEMEIN.cBerechtignunen.CHECK_BERECHTIGUNG_bool("DP_Bearbeiten", Me) Then Dim thisDgv As DataGridView = DirectCast(sender, DataGridView) Dim ht As DataGridView.HitTestInfo ht = thisDgv.HitTest(e.X, e.Y) If ht.Type = DataGridViewHitTestType.Cell Then thisDgv.ContextMenuStrip = ctxtDgv If thisDgv.SelectedCells.Count = 0 Then thisDgv.CurrentCell = thisDgv(ht.ColumnIndex, ht.RowIndex) thisDgv.CurrentCell.Selected = True End If End If If e.Button = Windows.Forms.MouseButtons.Right Then ' Dim ht As DataGridView.HitTestInfo ' ht = thisDgv.HitTest(e.X, e.Y) If ht.Type = DataGridViewHitTestType.Cell Then Dim o As usrCntlDienstWoche = Nothing If thisDgv.Parent.Parent.GetType = GetType(usrCntlDienstWoche) Then o = thisDgv.Parent.Parent For Each s In BEN_SCHICHTEN For Each cti As ToolStripItem In thisDgv.ContextMenuStrip.Items If cti.Name = "cti_" & s.schicht_name Then cti.Enabled = False For Each z In s.SCHICHT.ZEITEN 'MsgBox(s.schicht_name) 'MsgBox(thisDgv.Name & " _ " & getValuesDienstDGV(s, thisDgv.Name, "datum")) If z.dsz_woTag = week(CDate((getValuesDienstDGV(o, thisDgv.Name, "datum"))).DayOfWeek) Then 'Wochentag cti.Enabled = True ' wenn eintrag vorhanden, auswahl möglich End If Next End If Next Next If week(CDate((getValuesDienstDGV(o, thisDgv.Name, "datum"))).DayOfWeek) = "SA" Or week(CDate((getValuesDienstDGV(o, thisDgv.Name, "datum"))).DayOfWeek) = "SO" Then ctiUrlaub.Enabled = False ctiKrankenstand.Enabled = False ZeitausgleichToolStripMenuItem.Enabled = False Else ctiUrlaub.Enabled = True ctiKrankenstand.Enabled = True ZeitausgleichToolStripMenuItem.Enabled = True End If If thisDgv.SelectedCells.Count <= 1 Then thisDgv.CurrentCell = thisDgv(ht.ColumnIndex, ht.RowIndex) thisDgv.CurrentCell.Selected = True End If ' ctxtDgvSchicht1.Items(0).Text = String.Format("This is the cell at {0}, {1}", ht.ColumnIndex, ht.RowIndex) If o IsNot Nothing Then If o.SCHICHT.dedet_Splitschicht = True Then thisDgv.ContextMenuStrip = ContextMenuStrip1 If thisDgv.SelectedCells.Count = 0 Then thisDgv.CurrentCell = thisDgv(ht.ColumnIndex, ht.RowIndex) thisDgv.CurrentCell.Selected = True End If End If End If End If Else RemoveHandler DirectCast(sender, DataGridView).KeyDown, AddressOf changeByKey AddHandler thisDgv.KeyDown, AddressOf changeByKey 'MsgBox(dgv.Name) Exit Sub ' kein dragdrop Dim info As DataGridView.HitTestInfo = thisDgv.HitTest(e.X, e.Y) If info.RowIndex >= 0 Then Dim row As DataGridViewRow = thisDgv.Rows(info.RowIndex) thisDgv.DoDragDrop(row, DragDropEffects.All) End If End If End If End Sub Sub changeByKey(sender As Object, e As KeyEventArgs) If VERAG_PROG_ALLGEMEIN.cBerechtignunen.CHECK_BERECHTIGUNG_bool("DP_Bearbeiten", Me) Then Dim dgv As DataGridView = DirectCast(sender, DataGridView) If dgv.SelectedCells.Count > 0 Then ' Case "SO" : ctiSchicht1.Enabled = False : ctiDbl.Enabled = False : ctiQS.Enabled = False : ctiZollTag.Enabled = False : ctiUrlaub.Enabled = False : ctiKrankenstand.Enabled = False ' Case "SA" : ctiSchicht2.Enabled = False : ctiDbl.Enabled = False : ctiZollTag.Enabled = False : ctiUrlaub.Enabled = False : ctiKrankenstand.Enabled = False Dim o As usrCntlDienstWoche = Nothing If dgv.Parent.Parent.GetType() Is GetType(usrCntlDienstWoche) Then o = dgv.Parent.Parent Dim d As Date = CDate(getValuesDienstDGV(o, dgv.Name, "datum")) If o IsNot Nothing Then If o.SCHICHT.dedet_Splitschicht = True Then MsgBox("Keine Änderungen bei Splitschichten erlaubt!") Exit Sub End If End If For Each s In BEN_SCHICHTEN If e.KeyCode.ToString.ToUpper = s.SCHICHT.dedet_hotKey.ToUpper Then ' MsgBox("OK") For Each z In s.SCHICHT.ZEITEN If z.dsz_woTag = week(CDate((getValuesDienstDGV(o, dgv.Name, "datum"))).DayOfWeek) AndAlso s.SCHICHT.dedet_Splitschicht = False Then 'Wochentag 'Wenn Eintrag gefunden changeDGV(dgv, getDgvByDatArt(getValuesDienstDGV(o, dgv.Name, "datum"), s.schicht_name)) Exit Sub End If Next End If Next Select Case week(CDate(getValuesDienstDGV(o, dgv.Name, "datum")).DayOfWeek) Case "SA" Select Case e.KeyCode ' Case Keys.V : changeDGV(dgv, getDgvByDatArt(getValuesDienstDGV(Nothing, dgv.Name, "datum"), "ZOLL_VM")) ' Case Keys.Q : changeDGV(dgv, getDgvByDatArt(getValuesDienstDGV(Nothing, dgv.Name, "datum"), "QS")) Case Keys.F : changeDGV(dgv, getDgvByDatArt(getValuesDienstDGV(o, dgv.Name, "datum"), "FREI")) Case Keys.S : changeDGV(dgv, getDgvByDatArt(getValuesDienstDGV(o, dgv.Name, "datum"), "DR")) End Select Case "SO" Select Case e.KeyCode ' Case Keys.N : changeDGV(dgv, getDgvByDatArt(getValuesDienstDGV(Nothing, dgv.Name, "datum"), "ZOLL_NM")) ' Case Keys.T : changeDGV(dgv, getDgvByDatArt(getValuesDienstDGV(Nothing, dgv.Name, "datum"), "ZOLL_TAG")) Case Keys.F : changeDGV(dgv, getDgvByDatArt(getValuesDienstDGV(o, dgv.Name, "datum"), "FREI")) Case Keys.S : changeDGV(dgv, getDgvByDatArt(getValuesDienstDGV(o, dgv.Name, "datum"), "DR")) End Select Case Else Select Case e.KeyCode ' Case Keys.V : changeDGV(dgv, getDgvByDatArt(getValuesDienstDGV(Nothing, dgv.Name, "datum"), "ZOLL_VM")) ' Case Keys.N : changeDGV(dgv, getDgvByDatArt(getValuesDienstDGV(Nothing, dgv.Name, "datum"), "ZOLL_NM")) ' Case Keys.T : changeDGV(dgv, getDgvByDatArt(getValuesDienstDGV(Nothing, dgv.Name, "datum"), "ZOLL_TAG")) ' Case Keys.Q : changeDGV(dgv, getDgvByDatArt(getValuesDienstDGV(Nothing, dgv.Name, "datum"), "QS")) Case Keys.U : changeDGV(dgv, getDgvByDatArt(getValuesDienstDGV(o, dgv.Name, "datum"), "URL")) Case Keys.F : changeDGV(dgv, getDgvByDatArt(getValuesDienstDGV(o, dgv.Name, "datum"), "FREI")) Case Keys.K : changeDGV(dgv, getDgvByDatArt(getValuesDienstDGV(o, dgv.Name, "datum"), "KS")) Case Keys.S : changeDGV(dgv, getDgvByDatArt(getValuesDienstDGV(o, dgv.Name, "datum"), "DR")) Case Keys.Z : changeDGV(dgv, getDgvByDatArt(getValuesDienstDGV(o, dgv.Name, "datum"), "ZA")) End Select End Select End If End If End Sub Sub remHandlerKey(sender As Object, e As EventArgs) RemoveHandler DirectCast(sender, DataGridView).KeyDown, AddressOf changeByKey End Sub Sub clearBlackFont() For Each d In DGV For Each r As DataGridViewRow In getDGV(d.dgvName, d.USRCNTL).Rows r.DefaultCellStyle.Font = New Font(r.DataGridView.Font, FontStyle.Regular) Next Next If Panel6.Controls.Count > 0 Then DirectCast(Panel6.Controls(0), usrcntlDienstplanStunden).clearRowBg() End If End Sub Private Sub dgv_DragEnter(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs) e.Effect = DragDropEffects.All End Sub Private Sub dgv_DragDrop(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs) Dim row As DataGridViewRow = TryCast(e.Data.GetData(GetType(DataGridViewRow)), DataGridViewRow) If row IsNot Nothing Then Try changeDGV(row.DataGridView, DirectCast(sender, DataGridView)) Catch ex As Exception MessageBox.Show("dgv_DragDrop-Error: " & ex.Message) End Try End If End Sub Function getValuesDienstDGV2(o As usrCntlDienstWoche, dgvname As String, s As String) For Each d In DGV Dim o2 As usrCntlDienstWoche = Nothing o2 = d.USRCNTL If d.dgvName = dgvname Then ' MsgBox((o Is Nothing) & " - " & (o2 Is Nothing)) If o Is o2 Then ' MsgBox("GO") If s = "abt" Then Return d.dgvAbteilung If s = "von" Then Return d.dgvVon If s = "bis" Then Return d.dgvBis If s = "datum" Then Return d.dgvDatum End If End If Next Return "" End Function Function getValuesDienstDGV(o As usrCntlDienstWoche, dgvname As String, s As String) For Each d In DGV Dim o2 As usrCntlDienstWoche = Nothing o2 = d.USRCNTL If d.dgvName = dgvname Then If o Is o2 Then If s = "abt" Then Return d.dgvAbteilung If s = "von" Then Return d.dgvVon If s = "bis" Then Return d.dgvBis If s = "datum" Then Return d.dgvDatum End If End If Next Return "" End Function Function alreadyExists(d As DataGridView, s As String) As Boolean For Each r As DataGridViewRow In d.Rows If r.Cells(2).Value.ToString = s Then Return True Next Return False End Function Function removeRow(d As DataGridView, id As String) As Boolean Try For Each r As DataGridViewRow In d.Rows If r.Cells(0).Value.ToString = id Then d.Rows.RemoveAt(r.Index) : Return True Next Catch ex As Exception End Try Return False End Function Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click If vbYes = MsgBox("Möchten Sie wirklich neu initialisieren?" & vbNewLine & "(Dabei gehen alle Änderungen in dieser Woche verloren)", vbYesNoCancel) Then initALL() End If End Sub Public Sub initALL(Optional MAID As Integer = -1, Optional onlyFehlzeiten As Boolean = False) Me.Cursor = Cursors.WaitCursor ' Me.Enabled = False Dim dStart As Date = CalendarWeek(aktWoche, aktJahr) ' Label1.Text = dStart & " - " & dStart.AddDays(6) Dim montag As Date = CalendarWeek(aktWoche, aktJahr) Dim sonntag As Date = montag.AddDays(6) Dim cDienstAbwesendheiten As List(Of cDienstAbwesendheiten) = SQLDienst.getDienstAbwesendheiten(montag, sonntag, niederlassung) Dim ma As List(Of cDienstMA) = Nothing If MAID > 0 Then If Not SQLDienst.delDstEintraegeMaId(montag, sonntag, niederlassung, MAID, onlyFehlzeiten) Then Me.Cursor = Cursors.Default : Exit Sub 'Alles Löschen/Nur Fehlzeiten löschen ma = SQLDienst.getAllDienstMA(niederlassung, montag, " AND dstma_id = " & MAID) Else If Not SQLDienst.delDstEintraege(montag, sonntag, niederlassung, onlyFehlzeiten) Then Me.Cursor = Cursors.Default : Exit Sub 'Alles Löschen/Nur Fehlzeiten löschen ma = SQLDienst.getAllDienstMA(niederlassung, montag) End If Dim datum As Date = montag For i = 1 To 7 Dim FT As New VERAG_PROG_ALLGEMEIN.cFeiertage(datum.Year) 'Evtl Jahressprung, darum neu definieren For Each m In ma Dim eintrag As New cDienstEintrag eintrag.dstetr_dstmaId = m.dstma_id eintrag.dstetr_datum = datum Dim existingEntry = SQLDienst.getCountEntrys(eintrag.dstetr_dstmaId, eintrag.dstetr_datum, eintrag.dstetr_datum) If Not onlyFehlzeiten Or onlyFehlzeiten AndAlso existingEntry = 0 Then If Not FT.isFeiertag(datum, IIf(m.dstma_land <> "", m.dstma_land, SETTINGS.dpset_land)) Then If m.dstma_muster Then ' MsgBox("HIER") Dim tz As List(Of cDienstTeilzeit) = SQLDienst.getAllDienstTeilzeit(m.dstma_id) eintrag.dstetr_art = getFromTeilzeit(m.dstma_4wo, "abt", tz, datum, SCHICHT) If eintrag.dstetr_art = "" Then eintrag.dstetr_art = "FREI" Else ' MsgBox(getFromTeilzeit("von", tz, datum, SCHICHT) & " _ " & getFromTeilzeit("bis", tz, datum, SCHICHT)) eintrag.dstetr_von = getFromTeilzeit(m.dstma_4wo, "von", tz, datum, SCHICHT) eintrag.dstetr_bis = getFromTeilzeit(m.dstma_4wo, "bis", tz, datum, SCHICHT) eintrag.dstetr_pause = getFromTeilzeit(m.dstma_4wo, "pause", tz, datum, SCHICHT) ' eintrag.dstetr_pause = getDefaultTimeBySchicht(eintrag.dstetr_art, "pause", week(datum.DayOfWeek)) eintrag.dstetr_grund = "" eintrag.dstetr_info = getFromTeilzeit(m.dstma_4wo, "info", tz, datum, SCHICHT) 'MsgBox(eintrag.dstetr_art) eintrag.dstetr_art = getFromTeilzeit(m.dstma_4wo, "abt", tz, datum, SCHICHT) End If Else If m.dstma_arbvh = "VZ" Then If week(datum.DayOfWeek) = "SA" Or week(datum.DayOfWeek) = "SO" Then eintrag.dstetr_art = "FREI" Else eintrag.dstetr_art = getSchichtArt(m.dstma_abteilung, m.dstma_stammSchicht, datum) eintrag.dstetr_hauptsplitschicht = getBooleanHauptsplitschicht(m.dstma_stammSchicht) 'MsgBox(getSchichtArt(m.dstma_abteilung, m.dstma_stammSchicht, datum)) 'Abwesenheiten prüfen: ' For Each d In cDienstAbwesendheiten 'If d.dstna_mitId = eintrag.dstetr_dstmaId AndAlso d.dstna_datum_von <= datum And d.dstna_datum_bis >= datum Then ' eintrag.dstetr_art = d.dstna_grund 'End If ' Next End If eintrag.dstetr_von = getDefaultTimeBySchicht(eintrag.dstetr_art, "von", week(datum.DayOfWeek)) eintrag.dstetr_bis = getDefaultTimeBySchicht(eintrag.dstetr_art, "bis", week(datum.DayOfWeek)) eintrag.dstetr_pause = getDefaultTimeBySchicht(eintrag.dstetr_art, "pause", week(datum.DayOfWeek)) eintrag.dstetr_grund = "" eintrag.dstetr_info = "" If False Then If m.dstma_kuerzel = "AKPINAR" Then If Not week(datum.DayOfWeek) = "SA" And Not week(datum.DayOfWeek) = "SO" Then 'MsgBox("Hallo") ' eintrag.dstetr_von = "08:00" ' eintrag.dstetr_bis = "19:00" eintrag.dstetr_info = " 8-14 14:30-19" End If End If End If ' SQLDienst.updateInsertByDienstEintrag(eintrag, niederlassung) Else 'TEILZEIT eintrag.dstetr_art = "FREI" eintrag.dstetr_von = "00:00" eintrag.dstetr_bis = "00:00" eintrag.dstetr_pause = "0" eintrag.dstetr_grund = "" eintrag.dstetr_info = "" ' SQLDienst.updateInsertByDienstEintrag(eintrag, niederlassung) End If End If Else 'FEIERTAG eintrag.dstetr_art = "FREI" eintrag.dstetr_von = "00:00" eintrag.dstetr_bis = "00:00" eintrag.dstetr_pause = "0" eintrag.dstetr_grund = "" eintrag.dstetr_info = "" ' SQLDienst.updateInsertByDienstEintrag(eintrag, niederlassung) End If End If 'Abwesenheiten prüfen: For Each d In cDienstAbwesendheiten If d.dstna_mitId = eintrag.dstetr_dstmaId AndAlso d.dstna_datum_von <= datum And d.dstna_datum_bis >= datum Then Dim grund = d.dstna_grund.Replace("BS", "DR").Replace("SO", "DR") eintrag.dstetr_art = grund If week(datum.DayOfWeek) = "SA" Or week(datum.DayOfWeek) = "SO" Then eintrag.dstetr_art = "FREI" End If eintrag.dstetr_von = getDefaultTimeBySchicht(grund, "von", week(datum.DayOfWeek).ToUpper) eintrag.dstetr_bis = getDefaultTimeBySchicht(grund, "bis", week(datum.DayOfWeek).ToUpper) eintrag.dstetr_pause = getDefaultTimeBySchicht(grund, "pause", week(datum.DayOfWeek).ToUpper) End If Next If onlyFehlzeiten Then 'MsgBox("MA-ID: " & eintrag.dstetr_dstmaId & " " & "existingEntry: " & existingEntry & " Art: " & eintrag.dstetr_art & " DATUM: " & eintrag.dstetr_datum) If existingEntry = 1 AndAlso (eintrag.dstetr_art = "URL" Or eintrag.dstetr_art = "KS" Or eintrag.dstetr_art = "DR" Or eintrag.dstetr_art = "BS" Or eintrag.dstetr_art = "ZA") Or existingEntry = 0 Then SQLDienst.updateInsertByDienstEintrag(eintrag, niederlassung,, False) ElseIf existingEntry > 1 AndAlso (eintrag.dstetr_art = "URL" Or eintrag.dstetr_art = "KS" Or eintrag.dstetr_art = "DR" Or eintrag.dstetr_art = "BS" Or eintrag.dstetr_art = "ZA") Then 'wenn mehr als 1 Eintrag pro Tag -> Splitschicht SQLDienst.delDstEintraegeMaId(datum, datum, niederlassung, m.dstma_id) SQLDienst.updateInsertByDienstEintrag(eintrag, niederlassung,, False) End If Else SQLDienst.updateInsertByDienstEintrag(eintrag, niederlassung) End If Next datum = datum.AddDays(1) Next Me.Enabled = True initDienstplan() Me.Cursor = Cursors.Default End Sub Function getFromTeilzeit(dstma_4wo, switch, tz, datum, dienstplan) As String For Each t As cDienstTeilzeit In tz If t.dsttz_wotag = week(datum.DayOfWeek) Then If (dstma_4wo And dienstplan = t.dsttz_dienstplan) Or (Not dstma_4wo And t.dsttz_dienstplan.Contains(dienstplan.ToString.Substring(0, dienstplan.length - 1))) Then If switch = "von" Then Return t.dsttz_von If switch = "bis" Then Return t.dsttz_bis If switch = "pause" Then Return t.dsttz_pause If switch = "info" Then Return t.dsttz_bemerkung If switch = "abt" Then 'If t.dsttz_abt = "ZOLL1" Then Return "ZOLL_VM" 'If t.dsttz_abt = "ZOLL2" Then Return "ZOLL_NM" Return t.dsttz_abt End If End If End If Next Return "" End Function Public Function getSchichtArt(abteilung, stammschicht, datum) Dim s1 = "" Dim s2 = "" If stammschicht = "ZOLL TAG" Then Return "ZOLL_TAG" If abteilung = "NACHT" Then Return abteilung If stammschicht = "" Then Return "FREI" 'If stammschicht = "ZOLL 1" Then stammschicht = "ZOLL1" 'If stammschicht = "ZOLL 2" Then stammschicht = "ZOLL2" ' For Each s In SCHICHTEN_ARTEN ' MsgBox(stammschicht & " _ " & s.dedet_abt) If stammschicht = s.dedet_abt Then If s.dedet_TagesWechsel Then If SCHICHT.ToString.StartsWith("ROT") Then 'And (week(datum.DayOfWeek) <> "SA" And week(datum.DayOfWeek) <> "SO") Then 'Return s.dedet_WechselZuSchicht s1 = s.dedet_WechselZuSchicht s2 = s.dedet_bezeichnungDP Else s2 = s.dedet_WechselZuSchicht s1 = s.dedet_bezeichnungDP End If Else Return s.dedet_bezeichnungDP End If Exit For End If Next Select Case week(datum.DayOfWeek) Case "MO", "MI", "FR" Return s1 Case "DI", "DO" Return s2 End Select ' If stammschicht = "ZOLL 1" Then Return s1 ' If stammschicht = "ZOLL 2" Then Return s2 Return "" End Function Public Function getBooleanHauptsplitschicht(stammschicht) As Boolean For Each s In SCHICHTEN_ARTEN If stammschicht = s.dedet_abt Then Return s.dedet_Hauptsplitschicht End If Next Return False End Function Public Function getDefaultTimeBySchicht(abteilung, vonOrBis, woTag) abteilung = abteilung.ToString.Replace("ZOLL_VM", "ZOLL1") abteilung = abteilung.ToString.Replace("ZOLL_NM", "ZOLL2") Dim d As cDienstDetails = SQLDienst.getDienstDetailsWoTagByArtAndWoTag(niederlassung, abteilung, woTag) If vonOrBis = "von" Then If d.dedet_von <> "" Then Return d.dedet_von Else : Return "00:00" : End If If vonOrBis = "bis" Then If d.dedet_bis <> "" Then Return d.dedet_bis Else : Return "00:00" : End If If vonOrBis = "pause" Then Return d.dedet_pause : End If Return "" End Function Public Function getDefaultTimeBySchichtVon(abteilung, datum) If False Then If abteilung.ToString = "ZOLL_VM" Or abteilung.ToString = "ZOLL_NM" Then 'If week(datum.DayOfWeek) = "SA" Then Return "06:00" ' If week(datum.DayOfWeek) = "SO" Then Return "18:00" If abteilung = "ZOLL_VM" Then Return "06:00" If abteilung = "ZOLL_NM" Then Return "13:00" ElseIf abteilung.ToString = "QS" Then Return "08:00" ElseIf abteilung.ToString = "ZOLL_TAG" Then Return "08:00" End If Return "08:00" End If End Function Public Function getDefaultTimeBySchichtBis(abteilung, datum) If abteilung.ToString = "ZOLL_VM" Or abteilung.ToString = "ZOLL_NM" Then If week(datum.DayOfWeek) = "SA" Then Return "14:00" If week(datum.DayOfWeek) = "SO" Then Return "22:00" If abteilung = "ZOLL_VM" Then Return "13:00" If abteilung = "ZOLL_NM" Then Return "22:00" ElseIf abteilung.ToString = "QS" Then Return "17:00" ElseIf abteilung.ToString = "ZOLL_TAG" Then Return "17:00" ElseIf abteilung.ToString = "KS" Then Return "16:00" ElseIf abteilung.ToString = "URL" Then Return "16:00" End If Return "17:00" End Function Private Sub dgv_clearSelection(sender As Object, e As EventArgs) DirectCast(sender, DataGridView).ClearSelection() ' TextBox1.Text = "" ' TextBox2.Text = "" End Sub Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click Dim cc = New ColorConverter Dim DPmitSplitschichten As Boolean = False Dim txt As String = Button4.Text Button4.Text = txt & " (0 %)" Me.Cursor = Cursors.WaitCursor Dim exclApp As Object 'as Application Dim Datei As Object 'as WorkBook Dim Blatt As Microsoft.Office.Interop.Excel.Worksheet exclApp = CreateObject("Excel.Application") ' Dim nWeek As Integer ' nWeek = DatePart(DateInterval.WeekOfYear, New Date(2004, 3, 22), _ ' FirstDayOfWeek.Monday, FirstWeekOfYear.FirstFourDays) If Not My.Computer.FileSystem.DirectoryExists(Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\tmp\") Then My.Computer.FileSystem.CreateDirectory(Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\tmp\") End If Dim strFileName As String = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\tmp\tmp.xlsx" Try If DPcontainsSplitschichten() Then If vbYes = MsgBox("Dieser Dienstplan enthält Splitschichten." & vbCrLf & "DP mit Splitschichten ausgeben?", vbYesNo) Then DPmitSplitschichten = True End If End If With exclApp .Visible = False Datei = .Workbooks.Open(AppDomain.CurrentDomain.BaseDirectory & "Resources\Dienstplan Variabel.xlsx") Blatt = Datei.Worksheets("DIENSTPLAN") Dim d As Date = CalendarWeek(aktWoche, aktJahr) Blatt.Range("B2").Value = "MONTAG, " & d.ToString("dd.MMM") : d = d.AddDays(1) Blatt.Range("D2").Value = "DIENSTAG, " & d.ToString("dd.MMM") : d = d.AddDays(1) Blatt.Range("F2").Value = "MITTWOCH, " & d.ToString("dd.MMM") : d = d.AddDays(1) Blatt.Range("H2").Value = "DONNERSTAG, " & d.ToString("dd.MMM") : d = d.AddDays(1) Blatt.Range("J2").Value = "FREITAG, " & d.ToString("dd.MMM") : d = d.AddDays(1) Blatt.Range("L2").Value = "SAMSTAG, " & d.ToString("dd.MMM") : d = d.AddDays(1) Blatt.Range("N2").Value = "SO, " & d.ToString("dd.MMM") If SCHICHT.contains("ROT") Then Blatt.Range("A3").Font.Color = Color.Red Blatt.Range("H1").Font.Color = Color.Red Blatt.Range("H1").Value = "ROT" Else Blatt.Range("A3").Font.Color = Color.Blue Blatt.Range("H1").Font.Color = Color.Blue Blatt.Range("H1").Value = "BLAU" End If Blatt.Range("A2").Value = "KW " & aktWoche Button4.Text = txt & " (10 %)" Dim pos As Integer = 0 Dim zeilenheader = 1 'BORDER pos = 14 For Each s In BEN_SCHICHTEN If s.SCHICHT.dedet_Splitschicht = DPmitSplitschichten Or s.SCHICHT.dedet_Splitschicht = False Then Blatt.Range("A" & pos).Value = s.SCHICHT.dedet_bezeichnungExcel ' Blatt.Range("A" & pos).Style= = s.SCHICHT.dedet_bezeichnungExcel Blatt.Range("A" & pos + 1).Value = s.SCHICHT.dedet_bezeichnungExcel2 Blatt.Range("A" & pos + 2).Value = s.SCHICHT.dedet_bezeichnungExcel3 pos += s.SCHICHT.dedet_ZeilenExcel + zeilenheader End If Try ' MsgBox("A14:N" & pos - 1) Blatt.Range("A14:N" & pos - 1).BorderAround(Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium, Microsoft.Office.Interop.Excel.XlColorIndex.xlColorIndexAutomatic, Microsoft.Office.Interop.Excel.XlColorIndex.xlColorIndexAutomatic) Catch ex As Exception End Try Next 'Zeilenheader pos = 14 For Each s In BEN_SCHICHTEN If s.SCHICHT.dedet_Splitschicht = DPmitSplitschichten Or s.SCHICHT.dedet_Splitschicht = False Then For Each z In s.SCHICHT.ZEITEN Select Case z.dsz_woTag.ToUpper Case "MO" : Blatt.Range("B" & pos).Value = " " & IIf(z.dsz_von <> "" AndAlso z.dsz_bis <> "", z.dsz_von & " - " & z.dsz_bis & " Uhr", "") Case "DI" : Blatt.Range("D" & pos).Value = " " & IIf(z.dsz_von <> "" AndAlso z.dsz_bis <> "", z.dsz_von & " - " & z.dsz_bis & " Uhr", "") Case "MI" : Blatt.Range("F" & pos).Value = " " & IIf(z.dsz_von <> "" AndAlso z.dsz_bis <> "", z.dsz_von & " - " & z.dsz_bis & " Uhr", "") Case "DO" : Blatt.Range("H" & pos).Value = " " & IIf(z.dsz_von <> "" AndAlso z.dsz_bis <> "", z.dsz_von & " - " & z.dsz_bis & " Uhr", "") Case "FR" : Blatt.Range("J" & pos).Value = " " & IIf(z.dsz_von <> "" AndAlso z.dsz_bis <> "", z.dsz_von & " - " & z.dsz_bis & " Uhr", "") Case "SA" : Blatt.Range("L" & pos).Value = " " & IIf(z.dsz_von <> "" AndAlso z.dsz_bis <> "", z.dsz_von & " - " & z.dsz_bis & " Uhr", "") Case "SO" : Blatt.Range("N" & pos).Value = " " & IIf(z.dsz_von <> "" AndAlso z.dsz_bis <> "", z.dsz_von & " - " & z.dsz_bis & " Uhr", "") End Select Next End If Blatt.Range("B" & pos & ":N" & pos).Interior.Color = Color.FromArgb(197, 217, 241) pos += s.SCHICHT.dedet_ZeilenExcel + zeilenheader Next 'MONTAG pos = 15 For Each s In BEN_SCHICHTEN If s.SCHICHT.dedet_Splitschicht = DPmitSplitschichten Or s.SCHICHT.dedet_Splitschicht = False Then Dim z = s.SCHICHT.dedet_ZeilenExcel Dim Tag(z * 2 - 1) As String For i = 0 To z - 1 : Tag(i) = "B" & i + pos : Next For i = 0 To z - 1 : Tag(i + z) = "C" & i + pos : Next Blatt = fill(s.dgv_Mo, Tag, Blatt, "MO", s.SCHICHT) If (s.SCHICHT.dedet_ExcelMonatFarbe IsNot Nothing AndAlso s.SCHICHT.dedet_ExcelMonatFarbe.Substring(0, 1) = "#") Then For i = 0 To z - 1 : Blatt.Range("B" & i + pos & ":N" & i + pos).Interior.Color = ColorTranslator.ToOle(cc.ConvertFromString(s.SCHICHT.dedet_ExcelMonatFarbe.ToString())) : Next End If pos += z + zeilenheader End If Next Dim Zeile_ZA As Integer = 45 Dim Zeile_URL As Integer = 47 Dim Zeile_SO As Integer = 53 Dim Zeile_KS As Integer = 55 Dim ZAMo(4) As String For i = 0 To 1 : ZAMo(i) = "B" & i + Zeile_ZA : Next For i = 0 To 1 : ZAMo(i + 2) = "C" & i + Zeile_ZA : Next Dim UrlMo(8) As String For i = 0 To 3 : UrlMo(i) = "B" & i + Zeile_URL : Next For i = 0 To 3 : UrlMo(i + 4) = "C" & i + Zeile_URL : Next Dim SOMo(4) As String For i = 0 To 1 : SOMo(i) = "B" & i + Zeile_SO : Next For i = 0 To 1 : SOMo(i + 2) = "C" & i + Zeile_SO : Next Dim KSMo(6) As String For i = 0 To 2 : KSMo(i) = "B" & i + Zeile_KS : Next For i = 0 To 2 : KSMo(i + 3) = "C" & i + Zeile_KS : Next Blatt = fill(dgvZA_Mo, ZAMo, Blatt) Blatt = fill(dgvUrl_Mo, UrlMo, Blatt) Blatt = fill(dgvDR_Mo, SOMo, Blatt) Blatt = fill(dgvKS_Mo, KSMo, Blatt) Button4.Text = txt & " (25 %)" 'DIENSTAG pos = 15 For Each s In BEN_SCHICHTEN If s.SCHICHT.dedet_Splitschicht = DPmitSplitschichten Or s.SCHICHT.dedet_Splitschicht = False Then Dim z = s.SCHICHT.dedet_ZeilenExcel Dim Tag(z * 2 - 1) As String For i = 0 To z - 1 : Tag(i) = "D" & i + pos : Next For i = 0 To z - 1 : Tag(i + z) = "E" & i + pos : Next Blatt = fill(s.dgv_Di, Tag, Blatt, "DI", s.SCHICHT) pos += z + zeilenheader End If Next Dim ZADi(4) As String For i = 0 To 1 : ZADi(i) = "D" & i + Zeile_ZA : Next For i = 0 To 1 : ZADi(i + 2) = "E" & i + Zeile_ZA : Next Dim UrlDi(8) As String For i = 0 To 3 : UrlDi(i) = "D" & i + Zeile_URL : Next For i = 0 To 3 : UrlDi(i + 4) = "E" & i + Zeile_URL : Next Dim SODi(4) As String For i = 0 To 1 : SODi(i) = "D" & i + Zeile_SO : Next For i = 0 To 1 : SODi(i + 2) = "E" & i + Zeile_SO : Next Dim KSDi(6) As String For i = 0 To 2 : KSDi(i) = "D" & i + Zeile_KS : Next For i = 0 To 2 : KSDi(i + 3) = "E" & i + Zeile_KS : Next ' Blatt = fill(dgvZoll1_Di, zoll1Di, Blatt) ' Blatt = fill(dgvZoll2_Di, zoll2Di, Blatt) ' Blatt = fill(dgvZollTag_Di, zollTagdi, Blatt) ' Blatt = fillQS(dgvQS_Di, QSDi1, QSDi2, "D40", Blatt) Blatt = fill(dgvZA_Di, ZADi, Blatt) Blatt = fill(dgvUrl_Di, UrlDi, Blatt) Blatt = fill(dgvDR_Di, SODi, Blatt) Blatt = fill(dgvKS_Di, KSDi, Blatt) Button4.Text = txt & " (40 %)" 'MITTWOCH pos = 15 For Each s In BEN_SCHICHTEN If s.SCHICHT.dedet_Splitschicht = DPmitSplitschichten Or s.SCHICHT.dedet_Splitschicht = False Then Dim z = s.SCHICHT.dedet_ZeilenExcel Dim Tag(z * 2 - 1) As String For i = 0 To z - 1 : Tag(i) = "F" & i + pos : Next For i = 0 To z - 1 : Tag(i + z) = "G" & i + pos : Next Blatt = fill(s.dgv_Mi, Tag, Blatt, "MI", s.SCHICHT) pos += z + zeilenheader End If Next Dim ZAMi(4) As String For i = 0 To 1 : ZAMi(i) = "F" & i + Zeile_ZA : Next For i = 0 To 1 : ZAMi(i + 2) = "G" & i + Zeile_ZA : Next Dim UrlMi(8) As String For i = 0 To 3 : UrlMi(i) = "F" & i + Zeile_URL : Next For i = 0 To 3 : UrlMi(i + 4) = "G" & i + Zeile_URL : Next Dim SOMi(4) As String For i = 0 To 1 : SOMi(i) = "F" & i + Zeile_SO : Next For i = 0 To 1 : SOMi(i + 2) = "G" & i + Zeile_SO : Next Dim KSMi(6) As String For i = 0 To 2 : KSMi(i) = "F" & i + Zeile_KS : Next For i = 0 To 2 : KSMi(i + 3) = "G" & i + Zeile_KS : Next ' Blatt = fill(dgvZoll1_Mi, zoll1Mi, Blatt) ' Blatt = fill(dgvZoll2_Mi, zoll2Mi, Blatt) ' Blatt = fill(dgvZollTag_Mi, zollTagMi, Blatt) ' Blatt = fillQS(dgvQS_Mi, QSMi1, QSMi2, "F40", Blatt) Blatt = fill(dgvZA_Mi, ZAMi, Blatt) Blatt = fill(dgvUrl_Mi, UrlMi, Blatt) Blatt = fill(dgvDR_Mi, SOMi, Blatt) Blatt = fill(dgvKS_Mi, KSMi, Blatt) Button4.Text = txt & " (55 %)" 'DONNERSTAG pos = 15 For Each s In BEN_SCHICHTEN If s.SCHICHT.dedet_Splitschicht = DPmitSplitschichten Or s.SCHICHT.dedet_Splitschicht = False Then Dim z = s.SCHICHT.dedet_ZeilenExcel Dim Tag(z * 2 - 1) As String For i = 0 To z - 1 : Tag(i) = "H" & i + pos : Next For i = 0 To z - 1 : Tag(i + z) = "I" & i + pos : Next Blatt = fill(s.dgv_Do, Tag, Blatt, "DO", s.SCHICHT) pos += z + zeilenheader End If Next Dim ZADo(4) As String For i = 0 To 1 : ZADo(i) = "H" & i + Zeile_ZA : Next For i = 0 To 1 : ZADo(i + 2) = "I" & i + Zeile_ZA : Next Dim UrlDo(8) As String For i = 0 To 3 : UrlDo(i) = "H" & i + Zeile_URL : Next For i = 0 To 3 : UrlDo(i + 4) = "I" & i + Zeile_URL : Next Dim SODo(4) As String For i = 0 To 1 : SODo(i) = "H" & i + Zeile_SO : Next For i = 0 To 1 : SODo(i + 2) = "I" & i + Zeile_SO : Next Dim KSDo(6) As String For i = 0 To 2 : KSDo(i) = "H" & i + Zeile_KS : Next For i = 0 To 2 : KSDo(i + 3) = "I" & i + Zeile_KS : Next ' Blatt = fill(dgvZoll1_Do, zoll1Do, Blatt) ' Blatt = fill(dgvZoll2_Do, zoll2Do, Blatt) ' Blatt = fill(dgvZollTag_Do, zollTagDo, Blatt) ' Blatt = fillQS(dgvQS_Do, QSDo1, QSDo2, "H40", Blatt) Blatt = fill(dgvZA_Do, ZADo, Blatt) Blatt = fill(dgvUrl_Do, UrlDo, Blatt) Blatt = fill(dgvDR_Do, SODo, Blatt) Blatt = fill(dgvKS_Do, KSDo, Blatt) Button4.Text = txt & " (70 %)" 'FREITAG pos = 15 For Each s In BEN_SCHICHTEN If s.SCHICHT.dedet_Splitschicht = DPmitSplitschichten Or s.SCHICHT.dedet_Splitschicht = False Then Dim z = s.SCHICHT.dedet_ZeilenExcel Dim Tag(z * 2 - 1) As String For i = 0 To z - 1 : Tag(i) = "J" & i + pos : Next For i = 0 To z - 1 : Tag(i + z) = "K" & i + pos : Next Blatt = fill(s.dgv_Fr, Tag, Blatt, "FR", s.SCHICHT) pos += z + zeilenheader End If Next Dim ZAFr(4) As String For i = 0 To 1 : ZAFr(i) = "J" & i + Zeile_ZA : Next For i = 0 To 1 : ZAFr(i + 2) = "K" & i + Zeile_ZA : Next Dim UrlFr(8) As String For i = 0 To 3 : UrlFr(i) = "J" & i + Zeile_URL : Next For i = 0 To 3 : UrlFr(i + 4) = "K" & i + Zeile_URL : Next Dim SOFr(4) As String For i = 0 To 1 : SOFr(i) = "J" & i + Zeile_SO : Next For i = 0 To 1 : SOFr(i + 2) = "K" & i + Zeile_SO : Next Dim KSFr(6) As String For i = 0 To 2 : KSFr(i) = "J" & i + Zeile_KS : Next For i = 0 To 2 : KSFr(i + 3) = "K" & i + Zeile_KS : Next ' Blatt = fill(dgvZoll1_Fr, zoll1Fr, Blatt) ' Blatt = fill(dgvZoll2_Fr, zoll2Fr, Blatt) ' Blatt = fill(dgvZollTag_Fr, zollTagFr, Blatt) ' Blatt = fillQS(dgvQS_Fr, QSFr1, QSFr2, "J40", Blatt) Blatt = fill(dgvZA_Fr, ZAFr, Blatt) Blatt = fill(dgvUrl_Fr, UrlFr, Blatt) Blatt = fill(dgvDR_Fr, SOFr, Blatt) Blatt = fill(dgvKS_Fr, KSFr, Blatt) Button4.Text = txt & " (80 %)" 'SAMSTAG pos = 15 For Each s In BEN_SCHICHTEN If s.SCHICHT.dedet_Splitschicht = DPmitSplitschichten Or s.SCHICHT.dedet_Splitschicht = False Then Dim z = s.SCHICHT.dedet_ZeilenExcel Dim Tag(z * 2 - 1) As String For i = 0 To z - 1 : Tag(i) = "L" & i + pos : Next For i = 0 To z - 1 : Tag(i + z) = "M" & i + pos : Next Blatt = fill(s.dgv_Sa, Tag, Blatt, "SA", s.SCHICHT) pos += z + zeilenheader End If Next Dim ZASa(4) As String For i = 0 To 1 : ZASa(i) = "L" & i + Zeile_ZA : Next For i = 0 To 1 : ZASa(i + 2) = "M" & i + Zeile_ZA : Next Dim UrlSa(8) As String For i = 0 To 3 : UrlSa(i) = "L" & i + Zeile_URL : Next For i = 0 To 3 : UrlSa(i + 4) = "M" & i + Zeile_URL : Next Dim SOSa(4) As String For i = 0 To 1 : SOSa(i) = "L" & i + Zeile_SO : Next For i = 0 To 1 : SOSa(i + 2) = "M" & i + Zeile_SO : Next Dim KSSa(6) As String For i = 0 To 2 : KSSa(i) = "L" & i + Zeile_KS : Next For i = 0 To 2 : KSSa(i + 3) = "M" & i + Zeile_KS : Next ' Blatt = fill(dgvZoll1_Sa, zoll1Sa, Blatt) ' Blatt = fill(dgvZoll2_Sa, zoll2Sa, Blatt) 'Blatt = fill(dgvZollTag_Sa, zollTagSa, Blatt) ' Blatt = fillQS(dgvQS_Sa, QSSa1, QSSa2, "O40", Blatt) Blatt = fill(dgvZA_Sa, ZASa, Blatt) Blatt = fill(dgvUrl_Sa, UrlSa, Blatt) Blatt = fill(dgvDR_Sa, SOSa, Blatt) Blatt = fill(dgvKS_Sa, KSSa, Blatt) Button4.Text = txt & " (90 %)" 'SONNTAG pos = 15 For Each s In BEN_SCHICHTEN If s.SCHICHT.dedet_Splitschicht = DPmitSplitschichten Or s.SCHICHT.dedet_Splitschicht = False Then Dim z = s.SCHICHT.dedet_ZeilenExcel Dim Tag(z) As String For i = 0 To z - 1 : Tag(i) = "N" & i + pos : Next Blatt = fill(s.dgv_So, Tag, Blatt, "SO") pos += z + zeilenheader End If Next Dim ZASo(2) As String For i = 0 To 1 : ZASo(i) = "N" & i + Zeile_ZA : Next Dim UrlSo(8) As String For i = 0 To 3 : UrlSo(i) = "N" & i + Zeile_URL : Next Dim SOSo(2) As String For i = 0 To 1 : SOSo(i) = "N" & i + Zeile_SO : Next Dim KSSo(6) As String For i = 0 To 2 : KSSo(i) = "N" & i + Zeile_KS : Next ' Blatt = fill(dgvZoll1_So, zoll1So, Blatt) ' Blatt = fill(dgvZoll2_So, zoll2So, Blatt, "SO") ' Blatt = fill(dgvZollTag_So, zollTagSo, Blatt) ' Blatt = fillQS(dgvQS_So, QSSo, QSSo, "Q40", Blatt) Blatt = fill(dgvZA_So, ZASo, Blatt) Blatt = fill(dgvUrl_So, UrlSo, Blatt) Blatt = fill(dgvDR_So, SOSo, Blatt) Blatt = fill(dgvKS_So, KSSo, Blatt) Button4.Text = txt & " (100 %)" .Visible = True .DisplayAlerts = Word.WdAlertLevel.wdAlertsNone Try : Datei.SaveAs(strFileName) : Catch : End Try End With Catch ex As Exception MsgBox("ERRDP 7: " & ex.Message & ex.StackTrace) End Try Me.Cursor = Cursors.Default Button4.Text = txt End Sub Function fill(dgv As DataGridView, s() As String, Blatt As Excel.Worksheet, Optional dayOweek As String = "", Optional SCHICHT As cDienstplanSchicht = Nothing) As Excel.Worksheet With dgv If .RowCount > 0 Then Dim bg As Object = getBGFormSchichtSchichtArt(dayOweek, SCHICHT) If bg IsNot Nothing Then Blatt.Range(s(0), s(s.Length - 1)).Interior.Color = ColorTranslator.FromHtml(bg) Dim cnt As Integer = 0 For i = 0 To .RowCount - 1 Dim r As DataGridViewRow = .Rows(i) ' MsgBox("DGV: " & dgv.Name & " RAGNE: " & s(i) & " VALUE: " & r.Cells(1).Value) Try If r.Cells(1).Style.ForeColor <> Color.Black Then Blatt.Range(s(i)).Font.Color = ColorTranslator.FromHtml(r.Cells(9).Value) Catch : End Try Try : Blatt.Range(s(i)).Value = r.Cells(1).Value : Catch : End Try If dayOweek = "SO" Then Try : Blatt.Range(s(i)).Font.Color = Color.Red : Catch : End Try End If If i = 0 And (SCHICHT IsNot Nothing AndAlso SCHICHT.dedet_bezLeiter <> "") Then '(dgv.Name.Contains("Zoll1") Or dgv.Name.Contains("Zoll2")) Then Blatt.Range(s(i)).Value = Blatt.Range(s(i)).Value & " (" & SCHICHT.dedet_bezLeiter & ")" Dim start As Integer = Blatt.Range(s(i)).Value.ToString.Length - SCHICHT.dedet_bezLeiter.Length Blatt.Range(s(i)).Characters(Start:=start, Length:=SCHICHT.dedet_bezLeiter.Length).Font.Color = Color.Red End If 'KASSE färblich If r.Cells(1).Value.ToString.EndsWith("(KASSE)") Then Dim start As Integer = Blatt.Range(s(i)).Value.ToString.Length - 5 Blatt.Range(s(i)).Characters(Start:=start, Length:=5).Font.Color = Color.Red End If Next End If End With Return Blatt End Function Function fillNew(dgv As DataGridView, s() As String, Blatt As Excel.Worksheet, Optional dayOweek As String = "", Optional SCHICHT As cDienstplanSchicht = Nothing) As Excel.Worksheet With dgv If .RowCount > 0 Then Dim bg As Object = getBGFormSchichtSchichtArt(dayOweek, SCHICHT) If bg IsNot Nothing Then Blatt.Range(s(0), s(s.Length - 1)).Interior.Color = ColorTranslator.FromHtml(bg) Dim cnt As Integer = 0 For i = 0 To .RowCount - 1 Dim r As DataGridViewRow = .Rows(i) MsgBox("DGV: " & dgv.Name & " RAGNE: " & s(i) & " VALUE: " & r.Cells(1).Value) Try If r.Cells(1).Style.ForeColor <> Color.Black Then Blatt.Range(s(i)).Font.Color = ColorTranslator.FromHtml(r.Cells(9).Value) Catch : End Try Try : Blatt.Range(s(i)).Value = r.Cells(1).Value : Catch : End Try If dayOweek = "SO" Then Try : Blatt.Range(s(i)).Font.Color = Color.Red : Catch : End Try End If If i = 0 And (SCHICHT IsNot Nothing AndAlso SCHICHT.dedet_bezLeiter <> "") Then '(dgv.Name.Contains("Zoll1") Or dgv.Name.Contains("Zoll2")) Then Blatt.Range(s(i)).Value = Blatt.Range(s(i)).Value & " (" & SCHICHT.dedet_bezLeiter & ")" Dim start As Integer = Blatt.Range(s(i)).Value.ToString.Length - SCHICHT.dedet_bezLeiter.Length Blatt.Range(s(i)).Characters(Start:=start, Length:=SCHICHT.dedet_bezLeiter.Length).Font.Color = Color.Red End If 'KASSE färblich If r.Cells(1).Value.ToString.EndsWith("(KASSE)") Then Dim start As Integer = Blatt.Range(s(i)).Value.ToString.Length - 5 Blatt.Range(s(i)).Characters(Start:=start, Length:=5).Font.Color = Color.Red End If Next End If End With Return Blatt End Function Public Function getBGFormSchichtSchichtArt(dayOweek As String, Schicht_Tmp As cDienstplanSchicht) As Object If Schicht_Tmp IsNot Nothing Then If Schicht_Tmp.dedet_TagesWechsel Then Dim s1 As Object = Schicht_Tmp.dedet_ExcelBgFarbe Dim s2 As Object = Nothing For Each s In SCHICHTEN_ARTEN If s.dedet_bezeichnungDP = Schicht_Tmp.dedet_WechselZuSchicht Then s2 = s.dedet_ExcelBgFarbe End If Next If SCHICHT.ToString.StartsWith("ROT") Then 'And (week(datum.DayOfWeek) <> "SA" And week(datum.DayOfWeek) <> "SO") Then Dim tmp = s1 s1 = s2 s2 = tmp End If Select Case dayOweek Case "MO", "MI", "FR" Return s1 Case "DI", "DO", "SA" Return s2 End Select Else Return Schicht_Tmp.dedet_ExcelBgFarbe End If End If Return Nothing End Function Private Sub Schicht2ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ctiDbl.Click, ctiKrankenstand.Click, ctiFrei.Click, ctiDienstreise.Click, ctiUrlaub.Click, ctiWocheSchichtWechsel.Click, ctiBemWo.Click, ZeitausgleichToolStripMenuItem.Click Dim a As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem) Dim dgv_tmp As DataGridView = DirectCast(sender.GetCurrentParent.SourceControl, DataGridView) 'Dim vm = "ZOLL2" : If SCHICHT.contains("ROT") Then vm = "ZOLL1" ' Dim nm = "ZOLL1" : If SCHICHT.contains("BLAU") Then vm = "ZOLL2" Dim o As usrCntlDienstWoche = Nothing If dgv_tmp.Parent.Parent.GetType() Is GetType(usrCntlDienstWoche) Then o = dgv_tmp.Parent.Parent For Each s In BEN_SCHICHTEN If a.Name = "cti_" & s.schicht_name Then changeDGV(dgv_tmp, getDgvByDatArt(getValuesDienstDGV(o, dgv_tmp.Name, "datum"), s.schicht_name)) Exit Sub End If Next Select Case a.Name ' Case "ctiSchicht1" ' changeDGV(dgv_tmp, getDgvByDatArt(getValuesDienstDGV(dgv_tmp.Name, "datum"), "ZOLL_VM")) ' Case "ctiSchicht2" ' changeDGV(dgv_tmp, getDgvByDatArt(getValuesDienstDGV(dgv_tmp.Name, "datum"), "ZOLL_NM")) ' Case "ctiZollTag" ' changeDGV(dgv_tmp, getDgvByDatArt(getValuesDienstDGV(dgv_tmp.Name, "datum"), "ZOLL_TAG")) Case "ctiKrankenstand" changeDGV(dgv_tmp, getDgvByDatArt(getValuesDienstDGV(o, dgv_tmp.Name, "datum"), "KS")) Case "ctiQS" changeDGV(dgv_tmp, getDgvByDatArt(getValuesDienstDGV(o, dgv_tmp.Name, "datum"), "QS")) Case "ctiFrei" ' MsgBox(getValuesDienstDGV(Nothing, dgv_tmp.Name, "datum")) changeDGV(dgv_tmp, getDgvByDatArt(getValuesDienstDGV(o, dgv_tmp.Name, "datum"), "FREI")) Case "ctiDienstreise" changeDGV(dgv_tmp, getDgvByDatArt(getValuesDienstDGV(o, dgv_tmp.Name, "datum"), "DR")) Case "ctiUrlaub" changeDGV(dgv_tmp, getDgvByDatArt(getValuesDienstDGV(o, dgv_tmp.Name, "datum"), "URL")) ' Case "ctiDbl" ' changeDGVToDBL(dgv_tmp) Case "ctiWocheSchichtWechsel" changeDGVWoSchicht(dgv_tmp) Case "ctiBemWo" changeDGVWoBemerkung(dgv_tmp) Case "ZeitausgleichToolStripMenuItem" changeDGV(dgv_tmp, getDgvByDatArt(getValuesDienstDGV(o, dgv_tmp.Name, "datum"), "ZA")) Case "NormaldienstToolStripMenuItem" initALL(dgv_tmp.CurrentRow.Cells("dstma_id").Value) End Select End Sub Private Sub ToolStripMenuSplitschicht_Click(sender As Object, e As EventArgs) 'Handles ToolStripMenuSplitschicht.Click Dim a As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem) If sourceCnTxt Is Nothing Then Exit Sub Dim dgv_tmp As DataGridView = DirectCast(sourceCnTxt, DataGridView) Dim o As usrCntlDienstWoche = Nothing If dgv_tmp.Parent.Parent.GetType() Is GetType(usrCntlDienstWoche) Then o = dgv_tmp.Parent.Parent If o Is Nothing Then MsgBox("Keine Splitschichten erlaubt!") Exit Sub End If If o.SCHICHT.dedet_Hauptsplitschicht = False Then MsgBox("In Schicht " & o.schicht_name & " sind keine Splitschichten erlaubt!") Exit Sub End If Dim ids As New List(Of Integer) Dim arr As DataGridViewSelectedCellCollection = dgv_tmp.SelectedCells For Each c As DataGridViewCell In arr Dim r As DataGridViewRow = c.OwningRow ids.Add(r.Cells("dstma_id").Value) Next For Each s In BEN_SCHICHTEN If a.Name = "cti_" & s.schicht_name Then For Each id In ids Dim eintrag As New cDienstEintrag eintrag.dstetr_dstmaId = id Dim datum As Date = Date.Parse(getValuesDienstDGV(o, dgv_tmp.Name, "datum")) Dim abtSplitschicht As String = s.schicht_name Dim vorherigeAbt = getValuesDienstDGV(o, dgv_tmp.Name, "abt") eintrag.dstetr_datum = datum eintrag.dstetr_art = s.schicht_name eintrag.dstetr_splitschicht = s.SCHICHT.dedet_Splitschicht eintrag.dstetr_hauptsplitschicht = s.SCHICHT.dedet_Hauptsplitschicht Dim timeVontempDGV = getDgvByDatArt(getValuesDienstDGV(o, dgv_tmp.Name, "datum"), vorherigeAbt).CurrentRow.Cells("dstetr_von").Value Dim timeBistempDGV = getDgvByDatArt(getValuesDienstDGV(o, dgv_tmp.Name, "datum"), vorherigeAbt).CurrentRow.Cells("dstetr_bis").Value Dim timeVon = getDefaultTimeBySchicht(abtSplitschicht, "von", datum.ToString("ddd", New CultureInfo("de-DE")).Replace(".", "").ToUpper) Dim timeBis = getDefaultTimeBySchicht(abtSplitschicht, "bis", datum.ToString("ddd", New CultureInfo("de-DE")).Replace(".", "").ToUpper) If Not (checkUeberschneidungen(timeVon, timeVontempDGV) And checkUeberschneidungen(timeBis, timeVontempDGV) Xor checkUeberschneidungen(timeBistempDGV, timeVon) And checkUeberschneidungen(timeBistempDGV, timeBis)) Then If vbNo = MsgBox("ACHTUNG!" & vbCrLf & "Die Zeiten der Schicht " & s.schicht_name & " (" & timeVon & " - " & timeBis & ")" & vbCrLf & "überschneiden sich mit der Stammschicht " & vorherigeAbt & " (" & timeVontempDGV & " - " & timeBistempDGV & ")" & vbCrLf & "Trotzdem speichern?", vbYesNo) Then Exit Sub End If End If eintrag.dstetr_von = timeVon eintrag.dstetr_bis = timeBis If timeVon.Contains(":00") And timeBis.Contains(":00") Then eintrag.dstetr_info = timeVon.Replace(":00", "") & "-" & timeBis.Replace(":00", "") & "h" Else eintrag.dstetr_info = timeVon & "-" & timeBis End If If SQLDienst.getCountEntrys(eintrag.dstetr_dstmaId, datum, datum, True, eintrag.dstetr_art) > 0 Then If vbYes = MsgBox("ACHTUNG!" & vbCrLf & "Es gibt bereits einen Eintrag für diesen Mitarbeiter für " & s.schicht_name & " am " & datum & vbCrLf & "Trotzdem anlegen?", vbYesNo) Then Dim latestDienstplanEintragNr = SQLDienst.getLatestDienstplanEintraegNr() + 1 SQLDienst.updateInsertByDienstEintrag(eintrag, niederlassung, SQLDienst.getLatestDienstplanEintraegNr()) End If End If SQLDienst.updateInsertByDienstEintrag(eintrag, niederlassung) Next End If Next initDienstplan() End Sub Dim sourceCnTxt As Control = Nothing Private Sub GanzeWocheToolStripMenuItem_Click(sender As Object, e As EventArgs) ' Handles ctiDbl.Click, ctiKrankenstand.Click, ctiFrei.Click, ctiDienstreise.Click, ctiUrlaub.Click, ctiWocheSchichtWechsel.Click, ctiBemWo.Click, ZeitausgleichToolStripMenuItem.Click Dim a As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem) If sourceCnTxt Is Nothing Then Exit Sub 'a.GetCurrentParent.Parent ' Dim tddm As ToolStripDropDownMenu = DirectCast(sender.GetCurrentParent, ToolStripDropDownMenu) 'MsgBox(sourceCnTxt.Name) Dim dgv_tmp As DataGridView = DirectCast(sourceCnTxt, DataGridView) 'NormaldienstToolStripMenuItem.GetCurrentParent() Dim o As usrCntlDienstWoche = Nothing If dgv_tmp.Parent.Parent.GetType() Is GetType(usrCntlDienstWoche) Then o = dgv_tmp.Parent.Parent Dim datumtmp = CalendarWeek(aktWoche, aktJahr) 'Betroffene IDs suchen Dim ids As New List(Of Integer) Dim arr As DataGridViewSelectedCellCollection = dgv_tmp.SelectedCells For Each c As DataGridViewCell In arr Dim r As DataGridViewRow = c.OwningRow ids.Add(r.Cells("dstma_id").Value) Next 'BENUTZER SCHICHTEN: For Each s In BEN_SCHICHTEN If a.Name = "cti_" & s.schicht_name Then 'Schicht gefunden 'alle Wochentage durchlaufen: For i = 0 To 6 For Each sz In s.SCHICHT.ZEITEN If sz.dsz_woTag.ToUpper = datumtmp.ToString("ddd").Replace(".", "").ToUpper Then 'Wenn hier drin, dann gibt es an dem Tag den bezogenen Schichteintrag For Each id In ids 'Eintrag wird für alle IDs geändert SQLDienst.updateDienstEintragArtChangeByDstMaId(id, datumtmp, s.schicht_name, sz.dsz_von, sz.dsz_bis, "", sz.dsz_pause) Next End If Next datumtmp = datumtmp.AddDays(1) Next initDienstplan() Exit Sub End If Next Select Case a.Name Case "ctiKrankenstand" For i = 0 To 6 changeDGV(dgv_tmp, getDgvByDatArt(datumtmp, "KS")) Next Case "ctiFrei" For i = 0 To 6 changeDGV(dgv_tmp, getDgvByDatArt(datumtmp, "FREI")) Next Case "ctiDienstreise" For i = 0 To 6 changeDGV(dgv_tmp, getDgvByDatArt(datumtmp, "DR")) Next Case "ctiUrlaub" For i = 0 To 6 changeDGV(dgv_tmp, getDgvByDatArt(datumtmp, "URL")) Next Case "ZeitausgleichToolStripMenuItem" For i = 0 To 6 changeDGV(dgv_tmp, getDgvByDatArt(datumtmp, "ZA")) Next End Select End Sub ' Sub changeDGVToDBL(dgv_sender As DataGridView) ' Me.Cursor = Cursors.WaitCursor ' Try ' Dim arr As DataGridViewSelectedCellCollection = dgv_sender.SelectedCells ' For Each c As DataGridViewCell In arr ' Dim r As DataGridViewRow = c.OwningRow ' Dim von = getDefaultTimeBySchicht("DBL", "von", CDate(getValuesDienstDGV(dgv_sender.Name, "datum")).ToString("ddd", New CultureInfo("de-DE")).ToUpper) ' Dim bis = getDefaultTimeBySchicht("DBL", "bis", CDate(getValuesDienstDGV(dgv_sender.Name, "datum")).ToString("ddd", New CultureInfo("de-DE")).ToUpper) ' Dim pause = getDefaultTimeBySchicht("DBL", "pause", CDate(getValuesDienstDGV(dgv_sender.Name, "datum")).ToString("ddd", New CultureInfo("de-DE")).ToUpper) ' SQLDienst.updateDienstEintragArtChange(r.Cells(0).Value, getValuesDienstDGV(dgv_sender.Name, "datum"), "DBL", von, bis, pause) ' Next ' initDienstplan() ' Catch ex As Exception ' MessageBox.Show("changeDGVToDBL-Error: " & ex.Message) ' End Try ' Me.Cursor = Cursors.Default 'End Sub Sub changeDGVWoSchicht(dgv_sender As DataGridView) Me.Cursor = Cursors.WaitCursor Try If dgv_sender.SelectedCells.Count = 1 Then Dim maId = dgv_sender.CurrentRow.Cells(2).Value Dim montag As Date = CalendarWeek(aktWoche, aktJahr) If maId <= 0 Then Me.Cursor = Cursors.Default : Exit Sub Dim m As cDienstMA = SQLDienst.getDstMAByDstMaId(maId) If m Is Nothing Then Me.Cursor = Cursors.Default : Exit Sub If m.dstma_stammSchicht = "" Then Me.Cursor = Cursors.Default : Exit Sub Dim s1 = "" Dim s2 = "" For Each s In SCHICHTEN_ARTEN If s.dedet_abt = m.dstma_stammSchicht.Replace("ZOLL ", "ZOLL") Then If Not s.dedet_TagesWechsel Then Exit Sub s1 = s.dedet_bezeichnungDP s2 = s.dedet_WechselZuSchicht For i = 0 To 4 Dim datum = montag.AddDays(i) Dim abt = "" Select Case SQLDienst.getSchichtOnDate(maId, datum) Case s1 : abt = s2 Case s2 : abt = s1 End Select If abt <> "" Then Dim von As String = getDefaultTimeBySchicht(abt, "von", datum.ToString("ddd", New CultureInfo("de-DE")).Replace(".", "").ToUpper) Dim bis As String = getDefaultTimeBySchicht(abt, "bis", datum.ToString("ddd", New CultureInfo("de-DE")).Replace(".", "").ToUpper) Dim pause As String = getDefaultTimeBySchicht(abt, "pause", datum.ToString("ddd", New CultureInfo("de-DE")).Replace(".", "").ToUpper) SQLDienst.updateDienstEintragArtChangeByDstMaId(maId, datum, abt, von, bis, "", pause) End If Next initDienstplan() Me.Cursor = Cursors.Default Exit Sub End If Next Else MsgBox("Bei dieser Funktion muss genau ein Mitarbeiter ausgewählt sein!") End If Catch ex As Exception MessageBox.Show("changeDGVWoSchicht-Error: " & ex.Message) End Try initDienstplan() Me.Cursor = Cursors.Default End Sub Sub changeDGVWoBemerkung(dgv_sender As DataGridView) Me.Cursor = Cursors.WaitCursor Try If dgv_sender.SelectedCells.Count = 1 Then Dim maId = dgv_sender.CurrentRow.Cells(2).Value Dim montag As Date = CalendarWeek(aktWoche, aktJahr) Dim input = InputBox("Bitte geben Sie eine Bemerkung ein:", "Bemerkung ändern") If input <> "" Then SQLDienst.updateDienstBemerkungChange(maId, montag, montag.AddDays(4), input, niederlassung) Else MsgBox("Keine Bemerkung angegeben!") End If Else MsgBox("Bei dieser Funktion muss genau ein Mitarbeiter auswegählt sein!") End If initDienstplan() Catch ex As Exception MessageBox.Show("changeDGVWoBemerkung-Error: " & ex.Message) End Try Me.Cursor = Cursors.Default End Sub Sub checkMaTageIfTeilzeit(maId) Dim dMa As cDienstMA = SQLDienst.getDstMAByDstMaId(maId) If dMa.dstma_arbvh = "TZ" Then Dim daysEintrag = SQLDienst.getCountDays(maId, CalendarWeek(aktWoche, aktJahr), CalendarWeek(aktWoche, aktJahr).AddDays(6)) If dMa.dstma_TageProWoche >= 0 And daysEintrag > dMa.dstma_TageProWoche Then MsgBox(dMa.dstma_kuerzel & " wurde " & daysEintrag & " Mal eingetragen (Standard: " & dMa.dstma_TageProWoche & " Tage)!", vbInformation) End If End If End Sub Sub changeDGV(dgv_sender As DataGridView, dgv_receiver As DataGridView) Me.Cursor = Cursors.WaitCursor Try If dgv_sender IsNot Nothing And dgv_receiver IsNot Nothing Then ' MsgBox(dgv_sender.Name & " _ " & dgv_receiver.Name) Dim u_sender As usrCntlDienstWoche = Nothing Dim u_receiver As usrCntlDienstWoche = Nothing If dgv_sender.Parent.Parent.GetType Is GetType(usrCntlDienstWoche) Then u_sender = dgv_sender.Parent.Parent If dgv_receiver.Parent.Parent.GetType Is GetType(usrCntlDienstWoche) Then u_receiver = dgv_receiver.Parent.Parent If Not (dgv_sender.Name = dgv_receiver.Name And u_sender Is u_receiver) Then If getValuesDienstDGV(u_receiver, dgv_receiver.Name, "datum") = getValuesDienstDGV(u_sender, dgv_sender.Name, "datum") Then Dim arr As DataGridViewSelectedCellCollection = dgv_sender.SelectedCells For Each c As DataGridViewCell In arr Dim r As DataGridViewRow = c.OwningRow 'If Not alreadyExists(dgv_receiver, r.Cells(2).Value) Then Dim datum As Date = Date.Parse(getValuesDienstDGV(u_receiver, dgv_receiver.Name, "datum")) Dim abt As String = getValuesDienstDGV(u_receiver, dgv_receiver.Name, "abt") Dim von As String = getDefaultTimeBySchicht(abt, "von", datum.ToString("ddd", New CultureInfo("de-DE")).Replace(".", "").ToUpper) Dim bis As String = getDefaultTimeBySchicht(abt, "bis", datum.ToString("ddd", New CultureInfo("de-DE")).Replace(".", "").ToUpper) Dim pause As String = getDefaultTimeBySchicht(abt, "pause", datum.ToString("ddd", New CultureInfo("de-DE")).Replace(".", "").ToUpper) SQLDienst.updateDienstEintragArtChange(r.Cells(0).Value, datum.ToShortDateString, abt, von, bis, pause) If r.Cells("dstetr_hauptsplitschicht").Value Then If SQLDienst.getCountEntrys(r.Cells("dstma_id").Value, datum, datum, True) AndAlso (abt = "URL" Or abt = "DR" Or abt = "FREI" Or abt = "QS" Or abt = "KS" Or abt = "ZA") Then deleteSplitschichten(r.Cells("dstma_id").Value, datum, r.Cells(1).Value) End If End If If abt.Contains("ZOLL") Or abt = "QS" And r.Cells("dstma_arbvh").Value = "TZ" Then checkMaTageIfTeilzeit(r.Cells("dstma_id").Value) End If Next initDienstplan() End If End If End If Catch ex As Exception MessageBox.Show("changeDGV-Error: " & ex.Message) End Try Me.Cursor = Cursors.Default End Sub Function getDgvByDatArt(datum, art) As DataGridView For Each d As cDienstDGV In DGV If d.dgvDatum = datum And d.dgvAbteilung = art Then Return getDGV(d.dgvName, d.USRCNTL) Next Return Nothing End Function Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click AbwesenheitEintragen("URL") Exit Sub Dim frmDiestEintrag As New frmDiestEintrag frmDiestEintrag.niederlassung = niederlassung frmDiestEintrag.art = "URL" frmDiestEintrag.Show() End Sub Private Sub AbwesenheitEintragen(grund) ' MsgBox(e.ColumnIndex & " : " & e.RowIndex) If markId < 0 Then MsgBox("Mitarbeiter auswählen!") : Exit Sub Dim frmUrlKW As New frmUrlKW Dim art = "" frmUrlKW.KW = aktWoche frmUrlKW.YEAR = aktJahr 'Dim kw As Integer = dgvUrlaub.Rows(e.RowIndex).Cells(e.ColumnIndex).Tag ' Dim maId = markId Dim ll As List(Of cDienstAbwesendheitenKW) = SQLDienst.getDienstAbwesendheitenKWByArt(aktWoche, markId, aktJahr, niederlassung, grund) ' Dim ll As List(Of cDienstAbwesendheitenKW) = DP.getDienstAbwesendheitenKW(kw, aktJahr, niederlassung) ' MsgBox(e.ColumnIndex - 1) If ll.Count = 1 Then frmUrlKW.KW_ID = ll(0).dstnk_id ' frmUrlKW.KW_ID = ll(0).dstnk_grund ElseIf ll.Count > 1 Then Dim frmDienstAuswahl As New frmDienstAuswahl frmDienstAuswahl.list = ll frmDienstAuswahl.ShowDialog(Me) frmUrlKW.KW_ID = frmDienstAuswahl.kw_id Else frmUrlKW.ART = grund End If frmUrlKW.maId = markId frmUrlKW.niederlassung = niederlassung frmUrlKW.ShowDialog(Me) If frmUrlKW.RESULT <> "" Then ' MsgBox(markId) initALL(markId, True) End If End Sub Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click Me.Cursor = Cursors.WaitCursor aktDate = aktDate.AddDays(7) aktWoche = DateToWeek(aktDate).Substring(4, 2) aktJahr = DateToWeek(aktDate).Substring(0, 4) initWeekInfo() initDienstplan() Me.Cursor = Cursors.Default End Sub Private Sub Button7_Click(sender As Object, e As EventArgs) Handles Button7.Click Me.Cursor = Cursors.WaitCursor aktDate = aktDate.AddDays(-7) aktWoche = DateToWeek(aktDate).Substring(4, 2) aktJahr = DateToWeek(aktDate).Substring(0, 4) initWeekInfo() initDienstplan() Me.Cursor = Cursors.Default End Sub Private Sub Button8_Click(sender As Object, e As EventArgs) Handles Button8.Click Me.Cursor = Cursors.WaitCursor 'MsgBox(dgvZoll1_Mo.Rows(0).Cells(2).Value) Try If TextBox1.Text = "" Then Throw New Exception If TextBox2.Text = "" Then Throw New Exception If Not IsNumeric(TextBox4.Text) Then Throw New Exception If TextBox4.Text > 3 Or TextBox4.Text < 0 Then MsgBox("Die Pause darf nicht größer als 3 Stunden sein!") : Throw New Exception If cbxChangeForWo.Checked Then 'für ganze Woche Try Dim montag As Date = CalendarWeek(aktWoche, aktJahr) Dim maid = SQLDienst.getMaIdByEtrId(aktMitarbeiterEintrag) If maid <> "" Then SQLDienst.updateDienstEintragVonBisBemWOCHEChangeByMitId(CInt(maid), montag, montag.AddDays(4), TextBox1.Text, TextBox2.Text, TextBox3.Text, TextBox4.Text, niederlassung) End If Catch ex As Exception MsgBox("ERRDP 2: " & ex.Message) End Try Else 'für diesen Eintrag SQLDienst.updateDienstEintragArtBemerkungChange(aktMitarbeiterEintrag, TextBox1.Text, TextBox2.Text, TextBox3.Text, TextBox4.Text) End If cbxChangeForWo.Checked = False Catch ex As Exception MsgBox("Fehler beim Speichern des Eintrages.") End Try 'Where dsteintr_id=aktMitarbeiterEintrag initDienstplan() setDetails(entryId_TMP) Me.Cursor = Cursors.Default End Sub Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click TextBox1.Text = "10:00" TextBox2.Text = "19:00" End Sub Private Sub Button10_Click(sender As Object, e As EventArgs) Handles Button10.Click AbwesenheitEintragen("KS") Exit Sub Dim frmDiestEintrag As New frmDiestEintrag frmDiestEintrag.niederlassung = niederlassung frmDiestEintrag.art = "KS" frmDiestEintrag.Show() End Sub Private Sub Button12_Click(sender As Object, e As EventArgs) Handles Button12.Click AbwesenheitEintragen("DR") Exit Sub Dim frmDiestEintrag As New frmDiestEintrag frmDiestEintrag.niederlassung = niederlassung frmDiestEintrag.art = "DR" frmDiestEintrag.Show() End Sub Private Sub Button13_Click(sender As Object, e As EventArgs) Handles Button13.Click Dim frmUrlaubsplaner As New frmUrlaubsplaner frmUrlaubsplaner.niederlassung = niederlassung frmUrlaubsplaner.ShowDialog() Exit Sub frmDienstAbwesenheitenUebersicht.Show() End Sub Private Sub cboQSSpaet_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cboQSSpaet.SelectedIndexChanged 'Eintrag qs spät 'dstetr_id Dim montag As Date = CalendarWeek(aktWoche, aktJahr) For i = 0 To 5 If montag.AddDays(i).DayOfWeek = 6 Then SQLDienst.updateDienstEintragArtChangeByDstMaId(CType(cboQSSpaet.SelectedItem, VERAG_PROG_ALLGEMEIN.MyListItem).Value, montag.AddDays(i), "QS", "08:00", "12:00", "08-12", "0") Else SQLDienst.updateDienstEintragArtChangeByDstMaId(CType(cboQSSpaet.SelectedItem, VERAG_PROG_ALLGEMEIN.MyListItem).Value, montag.AddDays(i), "QS", "10:00", "19:00", "10-19", "1") End If Next initDienstplan() End Sub Public Function GetWeekStartDate(weekNumber As Integer, year As Integer) As Date Dim datum = New DateTime(year, 1, 1) Dim firstDayOfYear = datum.DayOfWeek Dim result = datum.AddDays(weekNumber * 7) If firstDayOfYear = DayOfWeek.Monday Then Return result.Date If firstDayOfYear = DayOfWeek.Tuesday Then Return result.AddDays(-1).Date If firstDayOfYear = DayOfWeek.Wednesday Then Return result.AddDays(-2).Date If firstDayOfYear = DayOfWeek.Thursday Then Return result.AddDays(-3).Date If firstDayOfYear = DayOfWeek.Friday Then Return result.AddDays(-4).Date If firstDayOfYear = DayOfWeek.Saturday Then Return result.AddDays(-5).Date Return result.AddDays(-6).Date End Function 'Private Function GetWeekStartDate3(weekNumber As Integer, year As Integer) As Date ' Dim calendar As Calendar = CultureInfo.CurrentCulture.Calendar ' Dim jan1 As DateTime = New DateTime(year, 1, 1) ' Dim daysOffset As Integer = DayOfWeek.Monday - jan1.DayOfWeek ' Dim firstMonday As DateTime = jan1.AddDays(daysOffset) ' Dim firstMondayWeekNum As Integer = calendar.GetWeekOfYear(firstMonday, CalendarWeekRule.FirstFourDayWeek, DayOfWeek.Monday) ' Dim firstWeekDay As DateTime = firstMonday.AddDays((weekNumber - firstMondayWeekNum) * 7) ' Return firstWeekDay 'End Function Private Function GetWeekStartDate2(weekNumber As Integer, year As Integer) As Date Dim startDate As New DateTime(year, 1, 1) Dim weekDate As DateTime = DateAdd(DateInterval.WeekOfYear, weekNumber - 1, startDate) Return DateAdd(DateInterval.Day, (-weekDate.DayOfWeek) + 1, weekDate) End Function Private Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Click If IsNumeric(txtKW.Text) AndAlso txtKW.Text < 54 AndAlso txtKW.Text > 0 Then If IsNumeric(txtKWYear.Text) AndAlso txtKWYear.Text < 3000 AndAlso txtKWYear.Text > 2000 Then Me.Cursor = Cursors.WaitCursor aktDate = GetWeekStartDate(txtKW.Text, txtKWYear.Text) aktWoche = DateToWeek(aktDate).Substring(4, 2) aktJahr = DateToWeek(aktDate).Substring(0, 4) initWeekInfo() initDienstplan() Me.Cursor = Cursors.Default End If End If End Sub Private Sub txtKW_KeyDown(sender As Object, e As KeyEventArgs) Handles txtKW.KeyDown, txtKWYear.KeyDown If e.KeyCode = Keys.Enter Then Button11.PerformClick() End Sub Private Sub Button14_Click(sender As Object, e As EventArgs) Handles Button14.Click Exit Sub ' Dim pf As New cProgramFunctions 'pf.KWAbschluss(niederlassung, aktJahr, aktWoche, SCHICHT) 'initDienstplan() End Sub Private Sub Button15_Click(sender As Object, e As EventArgs) Handles Button15.Click AbwesenheitEintragen("BS") End Sub Private Sub Button16_Click(sender As Object, e As EventArgs) Handles Button16.Click If vbYes = MsgBox("Möchten Sie die Woche wirklich löschen?", vbYesNoCancel) Then Dim datum As Date = CalendarWeek(aktWoche, aktJahr) SQLDienst.delDienstplanEintraege(datum, datum.AddDays(6), niederlassung) SQLDienst.delDienstplanUeberSdtMa(aktWoche, aktJahr, niederlassung) initDienstplan() End If End Sub Private Sub btnDetails_Click_1(sender As Object, e As EventArgs) initDetails(False) End Sub Sub initDetails(refresh As Boolean) If refresh Then 'nur Aktualisieren UsrcntlAuswertungWocheAuslastung1.init(CalendarWeek(aktWoche, aktJahr), niederlassung) End If End Sub Private Sub tbcntr_SelectedIndexChanged(sender As Object, e As EventArgs) Handles tbcntr.SelectedIndexChanged If sender.SelectedTab Is tbTagesverteilung Then If Not SETTINGS.dpset_StudenAuswertung Then sender.SelectedIndex = 0 UsrCntlAuswertungAuslastungMA1.Refresh() End If If sender.SelectedTab Is tbAuswertung Then If Not SETTINGS.dpset_AbfAuswertung Then sender.SelectedIndex = 0 initDetails(True) End If End Sub Private Sub frmDienstplanVariabel_Shown(sender As Object, e As EventArgs) Handles Me.Shown End Sub Private Sub Button17_Click(sender As Object, e As EventArgs) Handles Button17.Click usrCntlZeitenAendern1.Visible = True End Sub Private Sub ctxtDgv_Opening(sender As Object, e As System.ComponentModel.CancelEventArgs) Handles ctxtDgv.Opening If isSplitschicht Then Exit Sub sourceCnTxt = DirectCast(sender, ContextMenuStrip).SourceControl End Sub Private Sub Button18_Click(sender As Object, e As EventArgs) Handles Button18.Click If Panel6.Controls.Count > 0 Then Dim u As usrcntlDienstplanStunden = DirectCast(Panel6.Controls(0), usrcntlDienstplanStunden) If markId > 0 Then ' initALL(u.dgvStundenMa.SelectedRows(0).Cells("dstma_id").Value) initALL(markId) End If Else MsgBox("Kein Mitarbeiter ausgewählt!") End If End Sub Private Sub Button19_Click(sender As Object, e As EventArgs) Handles Button19.Click Dim txt As String = Button19.Text Button19.Text = txt & " (0 %)" Me.Cursor = Cursors.WaitCursor Dim exclApp As Object 'as Application Dim Datei As Object 'as WorkBook Dim Blatt As Microsoft.Office.Interop.Excel.Worksheet exclApp = CreateObject("Excel.Application") ' Dim nWeek As Integer ' nWeek = DatePart(DateInterval.WeekOfYear, New Date(2004, 3, 22), _ ' FirstDayOfWeek.Monday, FirstWeekOfYear.FirstFourDays) If Not My.Computer.FileSystem.DirectoryExists(Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\tmp\") Then My.Computer.FileSystem.CreateDirectory(Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\tmp\") End If Dim strFileName As String = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\tmp\tmp.xlsx" Try With exclApp .Visible = False Dim useAlwaysTime = False Select Case SQLDienst.getValueTxtBySql("SELECT isnull([dpset_firma],'') FROM [tblDienstSettings] WHERE [dpset_niederlassung]='" & niederlassung & "'", "ADMIN") Case "IMEX" Datei = .Workbooks.Open(AppDomain.CurrentDomain.BaseDirectory & "Resources\Dienstplan Variabel Monat IMEX.xlsx") Case "AMBAR" Datei = .Workbooks.Open(AppDomain.CurrentDomain.BaseDirectory & "Resources\Dienstplan Variabel Monat AMBAR.xlsx") useAlwaysTime = True Case Else Datei = .Workbooks.Open(AppDomain.CurrentDomain.BaseDirectory & "Resources\Dienstplan Variabel Monat.xlsx") End Select Blatt = Datei.Worksheets("DIENSTPLAN") Dim dt_Ma As DataTable = SQLDienst.loadDGV("SELECT TOP 25 [dstma_id],[dstma_mitId],[dstma_kuerzel],[dstma_arbvh] FROM [ADMIN].[dbo].[tblDienstMitarb] inner join tblMitarbeiter ON mit_id=dstma_mitId where dstma_niederlassung='" & niederlassung & "' and mit_gekuendigt=0 and dstma_inaktiv=0 order by dstma_reihenfolge, dstma_kuerzel") Dim cnt = 0 If dt_Ma IsNot Nothing Then '-----------------------Datum------------------- Dim dateWork = CDate("01." & aktDate.Month & "." & aktDate.Year & "") Dim dateEnde = dateWork.AddMonths(1).AddDays(-1) Blatt.Range("C1").Value = dateWork.ToString("MMMM yyyy") Dim FT As New VERAG_PROG_ALLGEMEIN.cFeiertage(dateWork.Year) 'Evtl Jahressprung, darum neu definieren Dim cnt3 = 0 While dateWork <= dateEnde Blatt.Range("A" & CInt(14 + cnt3).ToString).Value = dateWork.ToShortDateString & " " & dateWork.ToString("ddd").Replace(".", "") If dateWork.ToString("ddd").Replace(".", "") = "So" Then Blatt.Range("A" & CInt(14 + cnt3).ToString).Font.Color = Color.Red End If If FT.isFeiertag(dateWork, SETTINGS.dpset_land) Then Blatt.Range("B" & CInt(14 + cnt3).ToString & ":" & "Z" & CInt(14 + cnt3).ToString).Interior.Color = Color.Orange Blatt.Range("A" & CInt(14 + cnt3).ToString).Font.Color = Color.Red End If If dateWork.ToString("ddd").Replace(".", "") = "Mo" And cnt3 > 0 Then Blatt.Range("A" & CInt(14 + cnt3).ToString & ":" & "Z" & CInt(14 + cnt3).ToString).Borders(Excel.XlBordersIndex.xlEdgeTop).Weight = Excel.XlBorderWeight.xlMedium 'Blatt.Range("A" & CInt(14 + cnt3).ToString).Font.Color = Color.Red12 ' range.Borders(BordersLineType.DiagonalDown).LineStyle = LineStyleType.None End If dateWork = dateWork.AddDays(1) cnt3 += 1 End While '----------------------------------------------- For Each r As DataRow In dt_Ma.Rows Dim splate = Chr(Asc("B") + cnt) Blatt.Range(splate & "2").Value = r("dstma_kuerzel") If r("dstma_arbvh") = "TZ" Then Blatt.Range(splate & "2").Font.Color = Color.Red dateWork = CDate("01." & aktDate.Month & "." & aktDate.Year & "") dateEnde = dateWork.AddMonths(1).AddDays(-1) Button19.Text = txt & " (" & CInt((cnt / dt_Ma.Rows.Count) * 100) & " %)" Dim cnt2 = 0 While dateWork <= dateEnde Dim dt_Tag As DataTable = SQLDienst.loadDGV("SELECT TOP 1 * FROM [tblDienstplanEintraege] inner join [tblDienstplanEintraegeDetails] on [dedet_niederlassung]=[dstetr_niederlassung] AND dstetr_art=CASE WHEN dedet_bezeichnungDP='' THEN [dedet_abt] ELSE dedet_bezeichnungDP END where dstetr_niederlassung='" & niederlassung & "' AND dstetr_dstmaId='" & r("dstma_id") & "' and dstetr_datum='" & dateWork.ToShortDateString & "' AND (dedet_benutzerdefinierteSchicht=1 or [dedet_abt] IN ('DR','KS','URL')) ") Dim BGcolor = Nothing Dim Tag_Bez = "" If dt_Tag IsNot Nothing AndAlso dt_Tag.Rows.Count > 0 Then If dt_Tag.Rows(0)("dstetr_info") IsNot DBNull.Value AndAlso dt_Tag.Rows(0)("dstetr_info") <> "" Then Tag_Bez = dt_Tag.Rows(0)("dstetr_info") Else Tag_Bez = dt_Tag.Rows(0)("dstetr_von") & "-" & dt_Tag.Rows(0)("dstetr_bis") 'useAlwaysTime --> keine Bezeichnungen der Schicht zulassen, nur die Uhrzeiten Dim dt_Zeit = SQLDienst.loadDGV("SELECT * FROM [ADMIN].[dbo].[tblDienstplanSchichtenZeiten] where dsz_dedetId=" & dt_Tag.Rows(0)("dedet_id") & " and dsz_woTag='" & dateWork.ToString("ddd").Replace(".", "").ToUpper & "'") If dt_Tag IsNot Nothing AndAlso dt_Tag.Rows.Count > 0 Then If Not useAlwaysTime Or dt_Tag.Rows(0)("dedet_benutzerdefinierteSchicht") = 0 Then 'Wenn keine benutzerdefinierteSchicht ODER von=von, bis=bis --> Bezeichnung hinschreiben, sonst wird die Zeit (lt. oben) genau angegeben. If dt_Tag.Rows(0)("dedet_benutzerdefinierteSchicht") = 0 Or (dt_Zeit.Rows(0)("dsz_von") = dt_Tag.Rows(0)("dstetr_von") And dt_Zeit.Rows(0)("dsz_bis") = dt_Tag.Rows(0)("dstetr_bis")) Then If dt_Tag.Rows(0)("dedet_ExcelMonatBezeichnung") IsNot DBNull.Value AndAlso dt_Tag.Rows(0)("dedet_ExcelMonatBezeichnung") <> "" Then Tag_Bez = dt_Tag.Rows(0)("dedet_ExcelMonatBezeichnung") If dt_Tag.Rows(0)("dedet_ExcelMonatFarbe") IsNot DBNull.Value Then BGcolor = dt_Tag.Rows(0)("dedet_ExcelMonatFarbe") ElseIf dt_Tag.Rows(0)("dedet_bezeichnungDP") IsNot DBNull.Value AndAlso dt_Tag.Rows(0)("dedet_bezeichnungDP") <> "" Then Tag_Bez = dt_Tag.Rows(0)("dedet_bezeichnungDP") Else Tag_Bez = dt_Tag.Rows(0)("dedet_abt") End If ' Tag_Bez = If(dt_Tag.Rows(0)("dedet_bezeichnungDP") <> "", dt_Tag.Rows(0)("dedet_bezeichnungDP"), dt_Tag.Rows(0)("dedet_abt")) End If End If End If End If End If Blatt.Range(splate & CInt(14 + cnt2).ToString).Value = Tag_Bez If BGcolor IsNot Nothing Then Blatt.Range(splate & CInt(14 + cnt2).ToString).Interior.Color = ColorTranslator.FromHtml(BGcolor) cnt2 += 1 dateWork = dateWork.AddDays(1) End While cnt += 1 Next End If cnt = 0 For i = 0 To 25 'MsgBox(Blatt.Range(Chr(Asc("B") + cnt) & "2").Value) Try If Blatt.Range(Chr(Asc("B") + cnt) & "2").Value = "" Then Blatt.Range(Chr(Asc("B") + cnt) & ":" & Chr(Asc("B") + cnt)).EntireColumn.Hidden = True 'i -= 1 Else End If Catch ex As Exception End Try cnt += 1 'If Blatt.Range(Chr(Asc("B") + i) & "2").Interior.Color Then Exit For Next Button19.Text = txt & " (100 %)" .Visible = True .DisplayAlerts = Word.WdAlertLevel.wdAlertsNone Try : Datei.SaveAs(strFileName) : Catch : End Try End With Catch ex As Exception MsgBox("ERRDP 7: " & ex.Message & ex.StackTrace) End Try Me.Cursor = Cursors.Default Button19.Text = txt End Sub Private Sub Panel4_Paint(sender As Object, e As PaintEventArgs) Handles Panel4.Paint End Sub Private Function checkUeberschneidungen(time1 As String, time2 As String) As Boolean Dim a As DateTime = DateTime.ParseExact(time1, "HH:mm", System.Globalization.DateTimeFormatInfo.InvariantInfo) Dim b As DateTime = DateTime.ParseExact(time2, "HH:mm", System.Globalization.DateTimeFormatInfo.InvariantInfo) If a < b Then Return True Else Return False End If End Function Private Sub deleteSplitschichten(MAID As Integer, datum As Date, MAName As String) If vbYes = MsgBox("Achtung, es werden alle Splitschichten für Mitarbeiter " & MAName & " vom " & datum & " entfernt!" & vbCrLf & "Fortfahren?", vbYesNo) Then SQLDienst.delOnlyDstEintraegeSplitschichtenMaId(datum, niederlassung, MAID) End If End Sub Private Sub SchichtLöcshenToolStripMenuItem_Click(sender As Object, e As EventArgs) Try If vbYes = MsgBox("Möchten Sie die Splitschicht wirklich löschen?", vbYesNo) Then SQLDienst.delDstEintraegeSplitschichtenId(entryId_TMP) End If Catch ex As Exception MsgBox("Fehler beim Löschen des Eintrages.") End Try initDienstplan() End Sub Private Function DPcontainsSplitschichten() As Boolean For Each s In BEN_SCHICHTEN If s.SCHICHT.dedet_Splitschicht Then Return True Next Return False End Function Private Sub Button20_Click(sender As Object, e As EventArgs) Handles Button20.Click If Panel6.Controls.Count > 0 Then Dim u As usrcntlDienstplanStunden = DirectCast(Panel6.Controls(0), usrcntlDienstplanStunden) If markId > 0 Then initALL(markId, True) End If End If End Sub End Class