Imports System.Reflection Imports ClosedXML.Excel Public Class frmUrlaubsplaner Dim DP As New cDienstplan Dim ADMIN As New cOptionenDAL Public niederlassung = "" Dim aktJahr As Integer = Now.Year Dim dt As New DataTable Private Sub frmUrlaubsplaner_Load(sender As Object, e As EventArgs) Handles Me.Load lblMa.Text = "" lblKw.Text = "" Dim systemType As Type = dgvUrlaub.GetType() Dim propertyInfo As PropertyInfo = systemType.GetProperty("DoubleBuffered", BindingFlags.Instance Or BindingFlags.NonPublic) propertyInfo.SetValue(dgvUrlaub, True, Nothing) initDGV() cboJahr.Items.Clear() For j = 2018 To Now.Year + 1 cboJahr.Items.Add(New VERAG_PROG_ALLGEMEIN.MyListItem(j, j)) Next cboJahr.changeItem(Now.Year) Try dgvUrlaub.FirstDisplayedScrollingColumnIndex = (DateToWeek(Now) - 2).ToString.Substring(4) Catch ex As Exception End Try End Sub Dim loaded = False Sub initDGV() 'MsgBox("i") loaded = False With dgvUrlaub .SuspendLayout() ' .VirtualMode = False .Columns.Clear() Dim cMa As New DataGridViewTextBoxColumn cMa.HeaderText = "Mitarbeiter" cMa.Name = "maKuerzel" cMa.Width = 150 cMa.Frozen = True .Columns.Add(cMa) Dim cMaId As New DataGridViewTextBoxColumn cMaId.Visible = False cMaId.Name = "maId" .Columns.Add(cMaId) For Each r In DP.getAllDienstMA(niederlassung, CDate("01.01." & aktJahr)) .Rows.Add(r.dstma_kuerzel, r.dstma_id) ' & " " & r.mit_nname) ' .Rows(.RowCount - 1). Next For i = 1 To WeekCount(aktJahr) Dim c As New DataGridViewTextBoxColumn Dim d_Mo As Date = CalendarWeek(i, aktJahr) Dim d_So As Date = d_Mo.AddDays(6) c.HeaderText = "KW " & i & vbNewLine & d_Mo.ToString("dd.MM") & "-" & d_So.ToString("dd.MM") c.DefaultCellStyle.Alignment = DataGridViewContentAlignment.TopCenter c.Width = 70 .Columns.Add(c) .Columns(0).DefaultCellStyle.BackColor = Color.LightGray .Columns(0).DefaultCellStyle.ForeColor = Color.Black For Each r As DataGridViewRow In .Rows Dim ll = DP.getDienstAbwesendheitenKWByMA(r.Cells("maId").Value, i, aktJahr, niederlassung) If ll.Count > 1 Then r.Cells(.ColumnCount - 1).Value = "GEMISCHT" r.Cells(.ColumnCount - 1).Style.BackColor = Color.BlueViolet r.Cells(.ColumnCount - 1).Style.ForeColor = Color.White ElseIf ll.Count > 0 Then Dim l As cDienstAbwesendheitenKW = ll(0) r.Cells(.ColumnCount - 1).Value = l.dstnk_info Select Case l.dstnk_grund.Trim Case "URL" r.Cells(.ColumnCount - 1).Style.BackColor = Color.Red r.Cells(.ColumnCount - 1).Style.ForeColor = Color.White Case "KS" r.Cells(.ColumnCount - 1).Style.BackColor = Color.Blue r.Cells(.ColumnCount - 1).Style.ForeColor = Color.White Case "BS" r.Cells(.ColumnCount - 1).Style.BackColor = Color.Green r.Cells(.ColumnCount - 1).Style.ForeColor = Color.White Case "DR" r.Cells(.ColumnCount - 1).Style.BackColor = Color.Gray r.Cells(.ColumnCount - 1).Style.ForeColor = Color.White Case "ZA" r.Cells(.ColumnCount - 1).Style.BackColor = Color.Yellow r.Cells(.ColumnCount - 1).Style.ForeColor = Color.Black End Select End If If False Then Dim eintragCnt As Integer = 0 Dim eintragStr = "" For Each l As cDienstAbwesendheitenKW In ll If l.dstnk_mitId = r.Cells("maId").Value Then eintragCnt += 1 ' eintragStr &= CDate(l.dstna_datum_von).ToString("ddd") & " " End If If eintragCnt > 0 Then ' r.Cells(.ColumnCount - 1).Value = IIf(eintragCnt = 7, l.dstna_grund, eintragStr) r.Cells(.ColumnCount - 1).Value = IIf(eintragCnt = 7, l.dstnk_grund, eintragStr) r.Cells(.ColumnCount - 1).Tag = r.Cells("dstnk_kw").Value Select Case l.dstnk_grund.Trim Case "URL" r.Cells(.ColumnCount - 1).Style.BackColor = Color.Red r.Cells(.ColumnCount - 1).Style.ForeColor = Color.White Case "KS" r.Cells(.ColumnCount - 1).Style.BackColor = Color.Blue r.Cells(.ColumnCount - 1).Style.ForeColor = Color.White Case "BS" r.Cells(.ColumnCount - 1).Style.BackColor = Color.Green r.Cells(.ColumnCount - 1).Style.ForeColor = Color.White Case "DR" r.Cells(.ColumnCount - 1).Style.BackColor = Color.Gray r.Cells(.ColumnCount - 1).Style.ForeColor = Color.White Case "ZA" r.Cells(.ColumnCount - 1).Style.BackColor = Color.Yellow r.Cells(.ColumnCount - 1).Style.ForeColor = Color.Black End Select End If Next End If Next Next '.VirtualMode = True .ResumeLayout() End With loaded = True End Sub Public Function WeekCount(ByVal nYear As Integer) As Integer ' Ermittelt die Anzahl Wochen in einem Jahr Return CalendarWeek(1, nYear + 1).Subtract(CalendarWeek(1, nYear)).Days \ 7 End Function 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 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 dgvUrlaub_CellEnter(sender As Object, e As DataGridViewCellEventArgs) Handles dgvUrlaub.CellEnter lblMa.Text = "" lblKw.Text = "" ' MsgBox(dgvUrlaub.Columns(dgvUrlaub.SelectedCells(0).ColumnIndex).Name) If dgvUrlaub.SelectedCells.Count = 0 Then Exit Sub ' If dgvUrlaub.Columns(dgvUrlaub.SelectedCells(0).ColumnIndex).Name = "maKuerzel" Then Exit Sub lblMa.Text = dgvUrlaub.Rows(e.RowIndex).Cells("maKuerzel").Value lblKw.Text = "KW " & (e.ColumnIndex - 1) Exit Sub Dim fBold As New Font(dgvUrlaub.Font, FontStyle.Bold) For Each i As DataGridViewColumn In dgvUrlaub.Columns i.HeaderCell.Style = Nothing Next ' 'For Each i As DataGridViewRow In dgvUrlaub.Rows 'i.HeaderCell.Style = Nothing ' Next ' dgvUrlaub.Rows(e.RowIndex).Cells("maKuerzel").Style.Font = fBold dgvUrlaub.Columns(e.ColumnIndex).HeaderCell.Style.Font = fBold End Sub Private Sub dgvPrjDwgs_CellMouseEnter(sender As Object, e As System.Windows.Forms.DataGridViewCellEventArgs) Handles dgvUrlaub.CellMouseEnter If e.RowIndex > -1 Then For j = 0 To dgvUrlaub.ColumnCount - 1 Dim c = dgvUrlaub.Rows(e.RowIndex).Cells(j) If c.Value Is Nothing Then c.Style.BackColor = Color.BlanchedAlmond 'IIf(j = 0, Color.LightGray, Color.BlanchedAlmond) Next End If If e.ColumnIndex > -1 Then For j = 0 To dgvUrlaub.RowCount - 1 Dim c = dgvUrlaub.Rows(j).Cells(e.ColumnIndex) If c.Value Is Nothing Then c.Style.BackColor = Color.BlanchedAlmond Next End If End Sub Private Sub dgvPrjDwgs_CellMouseLeave(sender As Object, e As System.Windows.Forms.DataGridViewCellEventArgs) Handles dgvUrlaub.CellMouseLeave For i = 0 To dgvUrlaub.RowCount - 1 For j = 0 To dgvUrlaub.ColumnCount - 1 Dim c = dgvUrlaub.Rows(i).Cells(j) If c.Value Is Nothing Then c.Style.BackColor = IIf(j = 0, Color.LightGray, Color.White) Next Next End Sub Private Sub dgvUrlaub_CellClick(sender As Object, e As EventArgs) Handles dgvUrlaub.SelectionChanged Exit Sub dgvUrlaub.SuspendLayout() dgvUrlaub.DefaultCellStyle.BackColor = Color.White If dgvUrlaub.SelectedCells.Count > 0 Then ' 'dgvUrlaub.Rows(dgvUrlaub.SelectedCells(0).OwningRow.Index).Cells("maKuerzel").Style.BackColor = Color.Red ' : MsgBox(dgvUrlaub.SelectedRows(0).Cells("maKuerzel").Value) dgvUrlaub.Rows(dgvUrlaub.SelectedCells(0).OwningRow.Index).DefaultCellStyle.BackColor = Color.LightGray ' : MsgBox(dgvUrlaub.SelectedRows(0).Cells("maKuerzel").Value) dgvUrlaub.Columns(dgvUrlaub.SelectedCells(0).ColumnIndex).DefaultCellStyle.BackColor = Color.LightGray ' : MsgBox(dgvUrlaub.SelectedRows(0).Cells("maKuerzel").Value) End If dgvUrlaub.ResumeLayout() Exit Sub Dim fBold As New Font(dgvUrlaub.Font, FontStyle.Bold) Dim fRegular As New Font(dgvUrlaub.Font, FontStyle.Regular) If Not loaded Then Exit Sub With dgvUrlaub .SuspendLayout() For Each r In .Rows r.Cells("maKuerzel").Style.Font = fRegular Next For Each c In .Columns c.HeaderCell.Style.Font = fRegular Next If .SelectedCells(0).ColumnIndex > 1 And .SelectedCells(0).RowIndex >= 0 Then dgvUrlaub.Rows(.SelectedCells(0).RowIndex).Cells("maKuerzel").Style.Font = fBold dgvUrlaub.Columns(.SelectedCells(0).ColumnIndex).HeaderCell.Style.Font = fBold End If .ResumeLayout() End With End Sub Private Sub dgvUrlaub_CellDoubleClick(sender As Object, e As DataGridViewCellEventArgs) Handles dgvUrlaub.CellDoubleClick Me.Cursor = Cursors.WaitCursor ' MsgBox(e.ColumnIndex & " : " & e.RowIndex) If e.ColumnIndex > 1 And e.RowIndex >= 0 Then Dim frmUrlKW As New frmUrlKW Dim art = "" frmUrlKW.KW = e.ColumnIndex - 1 frmUrlKW.YEAR = aktJahr 'Dim kw As Integer = dgvUrlaub.Rows(e.RowIndex).Cells(e.ColumnIndex).Tag Dim maId = dgvUrlaub.Rows(e.RowIndex).Cells("maId").Value Dim ll As List(Of cDienstAbwesendheitenKW) = DP.getDienstAbwesendheitenKW(e.ColumnIndex - 1, maId, aktJahr, niederlassung) ' 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 End If frmUrlKW.maId = maId frmUrlKW.niederlassung = niederlassung frmUrlKW.ShowDialog(Me) If frmUrlKW.RESULT <> "" Then Select Case niederlassung Case "ATILLA" : frmDienstplanATILLA.initALL(maId) Case "WAI" : frmDienstplanATILLA.initALL(maId) Case "SBG" : frmDienstplanATILLA.initALL(maId) Case "NKD" : frmDienstplanATILLA.initALL(maId) Case "SUB" : frmDienstplan.initALL(maId) End Select End If Dim scroll = dgvUrlaub.HorizontalScrollingOffset initDGV() dgvUrlaub.HorizontalScrollingOffset = scroll End If Me.Cursor = Cursors.Default End Sub Private Sub btn_Click(sender As Object, e As EventArgs) dgvUrlaub.FirstDisplayedScrollingColumnIndex = 20 ' MsgBox(DateToWeek(Now) - 2) Exit Sub If dgvUrlaub.ColumnCount >= DateToWeek(Now) - 2 Then dgvUrlaub.FirstDisplayedScrollingColumnIndex = (DateToWeek(Now) - 2).ToString.Substring(4) End If End Sub Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click saveToDt() Try Dim dt1 As New DataTable() Dim dt2 As New DataTable() Dim halfOfYearWeek As Integer = 28 For Each column As DataGridViewColumn In dgvUrlaub.Columns If column.ValueType Is Nothing Then If column.Index < 2 Then dt1.Columns.Add(column.HeaderText, System.Type.GetType("System.String")) dt2.Columns.Add(column.HeaderText, System.Type.GetType("System.String")) ElseIf column.Index < halfOfYearWeek Then dt1.Columns.Add(column.HeaderText, System.Type.GetType("System.String")) Else dt2.Columns.Add(column.HeaderText, System.Type.GetType("System.String")) End If Else If column.Index < 2 Then dt1.Columns.Add(column.HeaderText, column.ValueType) dt2.Columns.Add(column.HeaderText, column.ValueType) ElseIf column.Index < halfOfYearWeek Then dt1.Columns.Add(column.HeaderText, column.ValueType) Else dt2.Columns.Add(column.HeaderText, column.ValueType) End If End If Next For Each row As DataGridViewRow In dgvUrlaub.Rows dt1.Rows.Add() dt2.Rows.Add() For Each cell As DataGridViewCell In row.Cells If cell.Value Is Nothing Then If cell.ColumnIndex < 2 Then dt1.Rows(dt1.Rows.Count - 1)(cell.ColumnIndex) = "" dt2.Rows(dt2.Rows.Count - 1)(cell.ColumnIndex) = "" ElseIf cell.ColumnIndex < halfOfYearWeek Then dt1.Rows(dt1.Rows.Count - 1)(cell.ColumnIndex) = "" Else dt2.Rows(dt2.Rows.Count - 1)(cell.ColumnIndex - (halfOfYearWeek - 2)) = "" End If Else If cell.ColumnIndex < 2 Then dt1.Rows(dt1.Rows.Count - 1)(cell.ColumnIndex) = cell.Value.ToString() dt2.Rows(dt2.Rows.Count - 1)(cell.ColumnIndex) = cell.Value.ToString() ElseIf cell.ColumnIndex < halfOfYearWeek Then dt1.Rows(dt1.Rows.Count - 1)(cell.ColumnIndex) = cell.Value.ToString() Else dt2.Rows(dt2.Rows.Count - 1)(cell.ColumnIndex - (halfOfYearWeek - 2)) = cell.Value.ToString() End If End If Next Next Dim sPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\SDL\tmp\" ' My.Computer.FileSystem.GetTempFileName If Not My.Computer.FileSystem.DirectoryExists(sPath) Then My.Computer.FileSystem.CreateDirectory(sPath) End If Dim wb As New XLWorkbook ' Dim dt As DataTable = (dgv.DataSource) ' Dim dt As DataTable = TryCast(dgv., DataTable) wb.Worksheets.Add(dt1, "URLAUB JH 1") wb.Worksheets.Add(dt2, "URLAUB JH 2") Dim filename As String = sPath & "Urlaubsplan_" & Now.ToString("ddMMyyyyHHmmss") & ".xlsx" wb.SaveAs(filename) Process.Start(filename) Catch ex As Exception MsgBox(ex.Message & ex.StackTrace) End Try End Sub Private Sub cboJahr_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cboJahr.SelectedIndexChanged If loaded Then aktJahr = cboJahr._value : initDGV() : End Sub Private Function saveToDt() As DataTable Dim dt As New DataTable() For Each column As DataGridViewColumn In dgvUrlaub.Columns If column.ValueType Is Nothing Then dt.Columns.Add(column.HeaderText, System.Type.GetType("System.String")) Else dt.Columns.Add(column.HeaderText, column.ValueType) End If Next For Each row As DataGridViewRow In dgvUrlaub.Rows dt.Rows.Add() For Each cell As DataGridViewCell In row.Cells If cell.Value Is Nothing Then dt.Rows(dt.Rows.Count - 1)(cell.ColumnIndex) = "" Else dt.Rows(dt.Rows.Count - 1)(cell.ColumnIndex) = cell.Value.ToString() End If Next Next Return dt End Function End Class