Imports System.Globalization Imports System.Text.RegularExpressions Imports ClosedXML.Excel Imports System.IO.Compression Public Class cProgramFunctions Shared Function getISO2Land(LandKz As String) Dim sqlstr = "SELECT TOP 1 isnull([Länderverzeichnis für die Außenhandelsstatistik].LandKz,'') AS LandKzISO2 FROM [Länderverzeichnis für die Außenhandelsstatistik] LEFT JOIN Währungstabelle ON [Länderverzeichnis für die Außenhandelsstatistik].LandNr = Währungstabelle.Währungsschlüssel WHERE Währungstabelle.LandKz='" & LandKz & "' " Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL Return SQL.getValueTxtBySql(sqlstr, "FMZOLL") End Function Shared Function getISO1Land(LandKz As String) Dim sqlstr = "SELECT TOP 1 isnull(Währungstabelle.LandKz,'') AS LandKzISO1 FROM [Länderverzeichnis für die Außenhandelsstatistik] LEFT JOIN Währungstabelle ON [Länderverzeichnis für die Außenhandelsstatistik].LandNr = Währungstabelle.Währungsschlüssel WHERE [Länderverzeichnis für die Außenhandelsstatistik].LandKz='" & LandKz & "' " Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL Return SQL.getValueTxtBySql(sqlstr, "FMZOLL") End Function Sub EINLESEN(datvon As Date, datbis As Date) ' As cBuergschaft Try Dim BRG As New cBrgDb Dim brg_AT As String = "05AT510000G000FP7" Dim brg_DE As String = "05DE0000000009345" 'ALT _ NICHT MEHR IN VERWENDUNG Dim brg_DE_NEU As String = "17DE0000000071678" ' BRG.getBrgFromFMZOLL(datEinlesenVon.Value.ToShortDateString, datEinlesenBis.Value.ToShortDateString, "50", "60","05AT510000G000FP7") ' BRG.getBrgSumFromFMZOLL_Zolaris(datEinlesenVon.Value.ToShortDateString, "50", "60", "05AT510000G000FP7") 'HIER datvon = CDate(datvon.ToShortDateString & " 00:00:00") datbis = CDate(datbis.ToShortDateString & " 00:00:00") ' Dim datvon As Date = datEinlesenVon.Value ' MsgBox(datvon.ToShortDateString & " - " & datbis.ToShortDateString) While datvon <= datbis ' MsgBox(datvon.ToShortDateString) Dim AtWoche_atlas As Double = 0 'BRG.getBrgSumFromFMZOLL_Zabis(datvon.ToShortDateString, datbisWo.ToShortDateString, "50", "60", brg_AT) AtWoche_atlas += BRG.getBrgSumFromFMZOLL_Zodiak(datvon.ToShortDateString, datvon.ToShortDateString, "50", "60", brg_AT) ' DATEN AUS DAKOSY/ZODIAK EINLESEN AtWoche_atlas += BRG.getBrgSumFrom_NCTS_TR(datvon.ToShortDateString, datvon.ToShortDateString, "50", "60", brg_AT) ' DATEN AUS DAKOSY/ZODIAK EINLESEN ' Dim DeWoche As String = BRG.getBrgSumFromFMZOLL_Zabis(datvon.ToShortDateString, datbisWo.ToShortDateString, "50", "60", brg_DE) 'DeWoche += BRG.getBrgSumFromFMZOLL_Zodiak(datvon.ToShortDateString, datbisWo.ToShortDateString, "50", "60", brg_DE) Dim De2Woche As Double = 0 'BRG.getBrgSumFromFMZOLL_Zabis(datvon.ToShortDateString, datbisWo.ToShortDateString, "50", "60", brg_DE_NEU) De2Woche += BRG.getBrgSumFromFMZOLL_Zodiak(datvon.ToShortDateString, datvon.ToShortDateString, "50", "60", brg_DE_NEU) ' DATEN AUS DAKOSY/ZODIAK EINLESEN De2Woche += BRG.getBrgSumFromFMZOLL_TELOTEC(datvon.ToShortDateString, datvon.ToShortDateString, "50", "60", brg_DE_NEU) ' DATEN AUS DAKOSY/ZODIAK EINLESEN De2Woche += BRG.getBrgSumFrom_NCTS_TR(datvon.ToShortDateString, datvon.ToShortDateString, "50", "60", brg_DE_NEU) ' DATEN AUS DAKOSY/ZODIAK EINLESEN ' MsgBox(BRG.getBrgSumFromFMZOLL_Zodiak(datvon.ToShortDateString, datbisWo.ToShortDateString, "50", "60", brg_DE_NEU)) ' Dim test As Double = BRG.getBrgSumFromFMZOLL_Zabis(datvon.ToShortDateString, datbisWo.ToShortDateString, "50", "60", brg_DE_NEU) Dim AtWoche_zolaris As Double = 0 AtWoche_zolaris += BRG.getBrgSumFromFMZOLL_Zolaris(datvon.ToShortDateString, datvon.ToShortDateString, "50", "60", brg_AT) AtWoche_zolaris += BRG.getBrgSumFromFMZOLL_TELOTEC(datvon.ToShortDateString, datvon.ToShortDateString, "50", "60", brg_AT) ' DATEN AUS TELOTEC EINLESEN ' MsgBox("getBrgSumFromFMZOLL_Zolaris: " & BRG.getBrgSumFromFMZOLL_Zolaris(datvon.ToShortDateString, datbisWo.ToShortDateString, "50", "60", brg_AT)) ' MsgBox("getBrgSumFromFMZOLL_TELOTEC: " & BRG.getBrgSumFromFMZOLL_TELOTEC(datvon.ToShortDateString, datbisWo.ToShortDateString, "50", "60", brg_AT)) 'UPDATE Dim buergschaft As cBuergschaft buergschaft = BRG.getBrgbyDate(datvon) If buergschaft Is Nothing Then buergschaft = New cBuergschaft ' MsgBox(datvon.ToString("dd.MM.yyyy")) buergschaft.brg_datum = datvon.ToShortDateString ' buergschaft.brg_at_tag_atlas = "" ' buergschaft.brg_at_tag_zolaris = "" buergschaft.brg_at_woche_atlas = StrIntValue(toDec(AtWoche_atlas)) buergschaft.brg_at_woche_zolaris = StrIntValue(toDec(AtWoche_zolaris)) buergschaft.brg_de_tag_atlas = "" buergschaft.brg_de_woche_atlas = "" 'StrIntValue(toDec(DeWoche)) buergschaft.brg_de2_woche_atlas = StrIntValue(toDec(De2Woche)) ' buergschaft.brg_at_tag = "" buergschaft.brg_at_woche = StrIntValue(toDec(buergschaft.brg_at_woche_atlas) + toDec(buergschaft.brg_at_woche_zolaris)) If datvon.ToShortDateString = Now.ToShortDateString Then buergschaft.brg_de2_tag_atlas = 0 + 'BRG.getBrgSumFromFMZOLL_Zabis(datvon.AddMonths(-3).ToShortDateString, datvon.ToShortDateString, "50", "50", brg_DE_NEU) + BRG.getBrgSumFromFMZOLL_Zodiak(datvon.AddMonths(-3).ToShortDateString, datvon.ToShortDateString, "50", "50", brg_DE_NEU) + BRG.getBrgSumFromFMZOLL_TELOTEC(datvon.AddMonths(-3).ToShortDateString, datvon.ToShortDateString, "50", "50", brg_DE_NEU) + BRG.getBrgSumFrom_NCTS_TR(datvon.AddMonths(-3).ToShortDateString, datvon.ToShortDateString, "50", "50", brg_DE_NEU) 'buergschaft.brg_de_tag_atlas = BRG.getBrgSumFromFMZOLL_Zabis(datvon.AddMonths(-3).ToShortDateString, datvon.ToShortDateString, "50", "50", brg_DE) buergschaft.brg_at_tag_atlas = 0 + ' BRG.getBrgSumFromFMZOLL_Zabis(datvon.AddMonths(-3).ToShortDateString, datvon.ToShortDateString, "50", "50", brg_AT) + BRG.getBrgSumFromFMZOLL_Zodiak(datvon.AddMonths(-3).ToShortDateString, datvon.ToShortDateString, "50", "50", brg_AT) + BRG.getBrgSumFromFMZOLL_TELOTEC(datvon.AddMonths(-3).ToShortDateString, datvon.ToShortDateString, "50", "50", brg_AT) + BRG.getBrgSumFrom_NCTS_TR(datvon.AddMonths(-3).ToShortDateString, datvon.ToShortDateString, "50", "50", brg_AT) Dim AtTag_zolaris As Double = BRG.getBrgSumFromFMZOLL_Zolaris(datvon.AddMonths(-3).ToShortDateString, datvon.ToShortDateString, "50", "50", brg_AT, " AND DatumBestimmungErreicht IS NULL ") AtTag_zolaris += BRG.getBrgSumFromFMZOLL_TELOTEC(datvon.AddMonths(-3).ToShortDateString, datvon.ToShortDateString, "50", "50", brg_AT) ' DATEN AUS TELOTEC EINLESEN buergschaft.brg_at_tag_zolaris = AtTag_zolaris 'BRG.getBrgSumFromFMZOLL_Zolaris(datvon.AddMonths(-3).ToShortDateString, datvon.ToShortDateString, "50", "50", brg_AT, " AND DatumBestimmungErreicht IS NULL ") buergschaft.brg_at_tag = StrIntValue(toDec(buergschaft.brg_at_tag_atlas) + toDec(AtTag_zolaris)) End If ' buergschaft.brg_de_tag = "" 'buergschaft.brg_de_tag_atlas ' buergschaft.brg_de_woche = buergschaft.brg_de_woche_atlas buergschaft.brg_de2_tag = buergschaft.brg_de2_tag_atlas buergschaft.brg_de2_woche = buergschaft.brg_de2_woche_atlas 'Update oder insert ' MsgBox(buergschaft.brg_datum & " _ " & buergschaft.brg_at_woche_atlas & " _ " & buergschaft.brg_at_woche_atlas) If Not BRG.setBrgUpdateInsertByDateAll(buergschaft) Then Exit While End If 'If Not BRG.setBrgUpdateInsertByDateOnlyWochenRef(buergschaft) Then 'Exit While ' End If datvon = datvon.AddDays(1) ' EINLESEN = buergschaft End While Catch ex As System.Exception MsgBox("Problem beim Einlesen!" & vbNewLine & ex.Message) MsgBox(ex.StackTrace) End Try ' EINLESEN = Nothing End Sub Private Function StrIntValue(ByVal d As Decimal) As String If d = 0 Then Return "" Else : Return d.ToString End If End Function Private Function toDec(ByVal s As Object) As Decimal Try If s Is Nothing Then Return 0 If s.ToString = "" Then Return 0 Return CDec(s) Catch ex As System.Exception Return 0 End Try End Function Public Function copyProgram(ByRef sourcePfad As String, ByVal destPfad As String, Optional ZIP As Boolean = False, Optional incrementalCopy As Boolean = False, Optional list As List(Of VERAG_PROG_ALLGEMEIN.cProgrammeUpdate) = Nothing) As Boolean If incrementalCopy Then Return VERAG_PROG_ALLGEMEIN.cProgrammeUpdate.copyProgramLIST(sourcePfad, destPfad, {}) ElseIf ZIP Then Return copyProgramZIP(sourcePfad, destPfad) Else Return copyProgramNOTZip(sourcePfad, destPfad) End If End Function Public Function copyProgramNOTZip(ByRef sourcePfad As String, ByVal destPfad As String) As Boolean If destPfad.Trim = "" Then Return False If sourcePfad.Trim = "" Then Return False If Not My.Computer.FileSystem.DirectoryExists(sourcePfad) Then MsgBox("ERROR_COPY_01: Quell-Ordner existiert nicht.", MsgBoxStyle.Critical, "ERROR") : Return False End If If Not My.Computer.FileSystem.DirectoryExists(destPfad) Then MsgBox("ERROR_COPY_02: Ziel-Ordner existiert nicht.", MsgBoxStyle.Critical, "ERROR") : Return False End If If delFiles(destPfad) Then Return FileCopier(sourcePfad, destPfad) Return False End Function Public Function copyProgramZIP(ByRef sourcePfad As String, ByVal destPfad As String) As Boolean If destPfad.Trim = "" Then Return False If sourcePfad.Trim = "" Then Return False If Not My.Computer.FileSystem.DirectoryExists(sourcePfad) Then MsgBox("ERROR_COPY_01: Quell-Ordner existiert nicht.", MsgBoxStyle.Critical, "ERROR") : Return False End If If Not My.Computer.FileSystem.DirectoryExists(destPfad) Then MsgBox("ERROR_COPY_02: Ziel-Ordner existiert nicht.", MsgBoxStyle.Critical, "ERROR") : Return False End If Dim zipPfad = "C:\Temp\Debug.zip" If System.IO.File.Exists(zipPfad) Then System.IO.File.Delete(zipPfad) ZipFile.CreateFromDirectory(sourcePfad, zipPfad, CompressionLevel.Optimal, False) If delFiles(destPfad) Then System.IO.File.Copy(zipPfad, destPfad & "Debug.zip", True) ZipFile.ExtractToDirectory(destPfad & "Debug.zip", destPfad) System.IO.File.Delete(destPfad & "Debug.zip") End If ' If delFiles(destPfad) Then Return FileCopier(sourcePfad, destPfad) Return False End Function Private Function FileCopier(ByRef sourcePfad As String, ByVal destPfad As String) As Boolean If Not destPfad.EndsWith("\") Then destPfad = destPfad & "\" Try For Each file As String In IO.Directory.GetFiles(sourcePfad) ' Ermittelt alle Dateien des Ordners IO.File.Copy(file, destPfad & cut_file(file), True) ' Kopiert die Dateien Next Next For Each file As String In IO.Directory.GetDirectories(sourcePfad) ' Ermittelt alle Unterordner des Ordners My.Computer.FileSystem.CopyDirectory(file, destPfad & cut_file(file), True) Next Catch ex As Exception MsgBox("ERROR_COPY_04: Fehler beim Kopieren", MsgBoxStyle.Critical, "ERROR") Return False End Try Return True End Function Public Function genEXCEL_Auswertungen(sPath, tage, startdate, ATAustellung, Gesamt, visible) As String Try Dim BRG As New cBrgDb 'Dim today As Date = Date.Today 'Dim dayIndex As Integer = today.DayOfWeek 'If dayIndex < DayOfWeek.Monday Then ' dayIndex += 7 'Monday is first day of week, no day of week should have a smaller index 'End If 'Dim dayDiff As Integer = dayIndex - DayOfWeek.Monday ' Dim monday As Date = today.AddDays(-dayDiff) ' Dim aktdate As Date = startdate.AddDays(-(tage - 1)) Dim buergschaften As List(Of cBuergschaft) = BRG.getBrgVonBis(aktdate.ToShortDateString, startdate.ToShortDateString) Dim exclApp As Object 'as Application Dim Datei As Object 'as WorkBook Dim Blatt As Object 'as WorkSheet exclApp = CreateObject("Excel.Application") ' Dim nWeek As Integer ' nWeek = DatePart(DateInterval.WeekOfYear, New Date(2004, 3, 22), _ ' FirstDayOfWeek.Monday, FirstWeekOfYear.FirstFourDays) With exclApp .Visible = False Try My.Computer.FileSystem.WriteAllBytes(sPath & "Auswertung.xlsx", My.Resources.Bürgschaften_Vorlage, False) Catch ex As System.Exception ' MsgBox(ex.Message) Return "ERROR 01: " & ex.Message & vbNewLine & ex.StackTrace End Try Datei = .Workbooks.Open(sPath & "Auswertung.xlsx") 'Anpassen Blatt = Datei.Worksheets("Auswertung") 'Anpassen 'Blatt.Range("A1").Value = TextBox1.Text Blatt.Range("A4").Value = tage & " Tage" Blatt.Range("A14").Value = "Gesamt " & tage & " Tage:" ' Dim today As Date = Now 'Dim aktdate As Date = today.AddDays(-6) 'Dim cnt As Integer = 6 For i As Integer = 6 To 6 + (tage - 1) Blatt.Range("A" & i).Value = aktdate.ToString("ddd, dd.MM.yyyy") ' MsgBox(aktdate.ToLongTimeString) For Each b In buergschaften If b.brg_datum = aktdate.ToShortDateString Then Blatt.Range("B" & i).Value = toDec(b.brg_at_woche) ': MsgBox(b.brg_at_woche) Blatt.Range("D" & i).Value = toDec(b.brg_at_tag) ': MsgBox(b.brg_at_tag) ' Blatt.Range("F" & i).Value = toDec(b.brg_de_woche) ': MsgBox(b.brg_de_woche) ' Blatt.Range("H" & i).Value = toDec(b.brg_de_tag) ': MsgBox(b.brg_de_tag) Blatt.Range("F" & i).Value = toDec(b.brg_de2_woche) ': MsgBox(b.brg_de_woche) Blatt.Range("H" & i).Value = toDec(b.brg_de2_tag) ': MsgBox(b.brg_de_tag) Exit For End If Next aktdate = aktdate.AddDays(1) Next If ATAustellung Then Blatt.Range("A18").Value = "Bürgschaft AT:" Blatt.Range("B19").Value = "ATLAS" aktdate = startdate.AddDays(-(tage - 1)) For i As Integer = 20 To 20 + (tage - 1) Blatt.Range("A" & i).Value = aktdate.ToString("ddd, dd.MM.yyyy") ' MsgBox(aktdate.ToLongTimeString) For Each b In buergschaften If b.brg_datum = aktdate.ToShortDateString Then Blatt.Range("B" & i).Value = toDec(b.brg_at_woche_atlas) ': MsgBox(b.brg_at_woche) Exit For End If Next aktdate = aktdate.AddDays(1) Next aktdate = startdate.AddDays(-(tage - 1)) Blatt.Range("B28").Value = "ZOLARIS" For i As Integer = 29 To 29 + (tage - 1) Blatt.Range("A" & i).Value = aktdate.ToString("ddd, dd.MM.yyyy") ' MsgBox(aktdate.ToLongTimeString) For Each b In buergschaften If b.brg_datum = aktdate.ToShortDateString Then Blatt.Range("B" & i).Value = toDec(b.brg_at_woche_zolaris) ': MsgBox(b.brg_at_woche) Exit For End If Next aktdate = aktdate.AddDays(1) Next End If If Gesamt Then Dim sum As Decimal = 0 Blatt.Range("H18").Value = "GESAMT" Blatt.Range("F27").Value = "Gesamt-Summe:" aktdate = startdate.AddDays(-(tage - 1)) For i As Integer = 19 To 19 + (tage - 1) Blatt.Range("F" & i).Value = aktdate.ToString("ddd, dd.MM.yyyy") ' MsgBox(aktdate.ToLongTimeString) For Each b In buergschaften If b.brg_datum = aktdate.ToShortDateString Then Blatt.Range("H" & i).Value = decSum(b.brg_at_woche, b.brg_de_woche, b.brg_de2_woche) ': MsgBox(b.brg_at_woche) sum += decSum(b.brg_at_woche, b.brg_de_woche, b.brg_de2_woche) Exit For End If Next Blatt.Range("H27").Value = sum aktdate = aktdate.AddDays(1) Next End If 'Datei.close(True) '.quit() ' Application.DisplayAlerts = False Datei.Save() 'If email Then ' sendPerMail(sPath & "Auswertung.xlsx") ' email = False '.Visible = False 'Datei.close(True) ' .quit() ' Else .Visible = visible If visible = False Then Datei.Save() .DisplayAlerts = False .quit() Try : Datei.close(True) : Catch : End Try End If 'End If ' Application.DisplayAlerts = True Return sPath & "Auswertung.xlsx" End With Catch ex As System.Exception ' MsgBox(ex.Message) Return "ERROR 02: " & ex.Message & vbNewLine & ex.StackTrace End Try End Function Public Shared Function genExcelFromDT_NEW(dt As DataTable, Optional rangeAsWaehrung() As String = Nothing, Optional ShowAutoFilter As Boolean = True, Optional HeaderTxt As String = "", Optional HeaderTxt2 As String = "") As String Try 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(dt, "DATEN") wb.Worksheets(0).Tables.FirstOrDefault().ShowAutoFilter = ShowAutoFilter If rangeAsWaehrung IsNot Nothing Then For Each r In rangeAsWaehrung Try wb.Worksheets(0).Range(r).Style.NumberFormat.SetFormat("###,###,##0.00 €") Catch ex As Exception MsgBox(ex.Message & ex.StackTrace) End Try Next End If If HeaderTxt <> "" Then wb.Worksheets(0).FirstRow.InsertRowsAbove(2) wb.Worksheets(0).Range("A1").Value = HeaderTxt wb.Worksheets(0).Range("A1").Style.Font.Bold = True If HeaderTxt2 <> "" Then wb.Worksheets(0).Range("A2").Value = HeaderTxt2 wb.Worksheets(0).Row(2).InsertRowsBelow(1) End If End If Dim filename As String = sPath & "tmp_" & Now.ToString("ddMMyyyyHHmmss") & ".xlsx" wb.SaveAs(filename) Process.Start(filename) Return filename Catch ex As Exception MsgBox(ex.Message & ex.StackTrace) Return Nothing End Try End Function Public Shared Function dgridViewTods(ByVal dgv As DataGridView) As DataTable Dim dt As New DataTable Try ' Add Table ' ds.Tables.Add("Invoices") ' Add Columns Dim col As DataColumn For Each dgvCol As DataGridViewColumn In dgv.Columns col = New DataColumn(dgvCol.Name) dt.Columns.Add(col) Next 'Add Rows from the datagridview Dim row As DataRow Dim colcount As Integer = dgv.Columns.Count - 1 For i As Integer = 0 To dgv.Rows.Count - 1 row = dt.Rows.Add For Each column As DataGridViewColumn In dgv.Columns row.Item(column.Index) = dgv.Rows.Item(i).Cells(column.Index).Value Next Next Return dt Catch ex As Exception MsgBox("CRITICAL ERROR : Exception caught while converting dataGridView to DataSet (dgvtods).. " & Chr(10) & ex.Message) Return Nothing End Try End Function Public Shared Sub genExcelFromDGV_NEW(dgv As DataGridView, Optional onlyVisible As Boolean = False) 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(dgridViewTods(dgv), "DATEN") Dim filename As String = sPath & "tmp_" & Now.ToString("ddMMyyyyHHmmss") & ".xlsx" wb.SaveAs(filename) Process.Start(filename) Exit Sub Dim fn As String = sPath & "tmp_" & Now.ToString("ddMMyyyyHHmmss") & ".csv" Dim outFile As IO.StreamWriter = My.Computer.FileSystem.OpenTextFileWriter(fn, False) Dim clmns As String = "" For i = 0 To dgv.ColumnCount - 1 If Not onlyVisible Or (onlyVisible And dgv.Columns(i).Visible = True) Then clmns &= dgv.Columns(i).HeaderText.ToString().Replace(";", ",") & ";" End If Next outFile.WriteLine(clmns) For i = 0 To dgv.RowCount - 1 clmns = "" For j = 0 To dgv.ColumnCount - 1 If Not onlyVisible Or (onlyVisible And dgv.Columns(j).Visible = True) Then clmns &= getValue(dgv(j, i)) & ";" End If Next outFile.WriteLine(clmns) Next outFile.Close() Try Dim p As New Process p.StartInfo.FileName = "Excel.exe" p.StartInfo.Arguments = fn p.EnableRaisingEvents = True p.Start() ' AddHandler p.Exited, AddressOf cleartmp 'Löscht die Temp-Dateien Catch ex As Exception MsgBox("Excel konnte nicht gestartet werden!" & vbNewLine & vbNewLine & ex.Message) End Try End Sub Shared Function getValue(o As DataGridViewCell) As String Try If o.ValueType.ToString = "System.Boolean" Then If o.Value Is DBNull.Value Then Return "NEIN" Select Case o.Value Case True : Return "JA" Case False : Return "NEIN" End Select Else Return o.Value.ToString().Replace(";", ",") End If Catch ex As Exception End Try Return "" End Function Public Function genEXCEL_AuswertungenKW(sPath, KW, YEAR, visible) As String Try Dim BRG As New cBrgDb Dim monday As Date = CalendarWeek(KW, YEAR) Dim sunday As Date = monday.AddDays(6) Dim usrctlBuergschaft As New usrctlBuergschaft Dim atilla_sum_at = BRG.getBrgSumFromFMZOLL_Zabis(monday.ToShortDateString, sunday.ToShortDateString, "50", "60", usrctlBuergschaft.brg_AT, " AND veoant_beznr NOT LIKE 'DU%' AND basman_nl='SUW' ") Dim atilla_sum_at_zol = BRG.getBrgSumFromFMZOLL_Zolaris(monday.ToShortDateString, sunday.ToShortDateString, "50", "60", usrctlBuergschaft.brg_AT, " AND OperatorId IN ('5','6') ") Dim atilla_sum_de = BRG.getBrgSumFromFMZOLL_Zabis(monday.ToShortDateString, sunday.ToShortDateString, "50", "60", usrctlBuergschaft.brg_DE, " AND veoant_beznr NOT LIKE 'DU%' AND basman_nl='SUW' ") Dim atilla_sum_de2 = BRG.getBrgSumFromFMZOLL_Zabis(monday.ToShortDateString, sunday.ToShortDateString, "50", "60", usrctlBuergschaft.brg_DE_NEU, " AND veoant_beznr NOT LIKE 'DU%' AND basman_nl='SUW' ") Dim atilla_sum_de2_DY = BRG.getBrgSumFromFMZOLL_Zodiak(monday.ToShortDateString, sunday.ToShortDateString, "50", "60", usrctlBuergschaft.brg_DE_NEU, " AND ncts_ObjectName NOT LIKE 'DU%' ") atilla_sum_de2 += atilla_sum_de2_DY Dim durmaz_sum_at = BRG.getBrgSumFromFMZOLL_Zabis(monday.ToShortDateString, sunday.ToShortDateString, "50", "60", usrctlBuergschaft.brg_AT, " AND veoant_beznr LIKE 'DU%' AND basman_nl='SUW' ") Dim durmaz_sum_de = BRG.getBrgSumFromFMZOLL_Zabis(monday.ToShortDateString, sunday.ToShortDateString, "50", "60", usrctlBuergschaft.brg_DE, " AND veoant_beznr LIKE 'DU%' AND basman_nl='SUW' ") Dim durmaz_sum_de2 = BRG.getBrgSumFromFMZOLL_Zabis(monday.ToShortDateString, sunday.ToShortDateString, "50", "60", usrctlBuergschaft.brg_DE_NEU, " AND veoant_beznr LIKE 'DU%' AND basman_nl='SUW' ") Dim durmaz_sum_de2_DY = BRG.getBrgSumFromFMZOLL_Zodiak(monday.ToShortDateString, sunday.ToShortDateString, "50", "60", usrctlBuergschaft.brg_DE_NEU, " AND ncts_ObjectName NOT LIKE 'DU%' ") durmaz_sum_de2 += durmaz_sum_de2_DY ' MsgBox(atilla_sum_at_zol) Dim top_atilla_at As List(Of topValues) = BRG.getBrgTop5FromFMZOLL_Zabis(monday.ToShortDateString, sunday.ToShortDateString, "50", "60", usrctlBuergschaft.brg_AT, " AND veoant_beznr NOT LIKE 'DU%' AND basman_nl='SUW' ") Dim top_atilla_de As List(Of topValues) = BRG.getBrgTop5FromFMZOLL_Zabis(monday.ToShortDateString, sunday.ToShortDateString, "50", "60", usrctlBuergschaft.brg_DE, " AND veoant_beznr NOT LIKE 'DU%' AND basman_nl='SUW' ") Dim top_atilla_de_DY As List(Of topValues) = BRG.getBrgTop5FromFMZOLL_Zodiak(monday.ToShortDateString, sunday.ToShortDateString, "50", "60", usrctlBuergschaft.brg_DE, " AND ncts_ObjectName NOT LIKE 'DU%' ") Dim top_atilla_de2 As List(Of topValues) = BRG.getBrgTop5FromFMZOLL_Zabis(monday.ToShortDateString, sunday.ToShortDateString, "50", "60", usrctlBuergschaft.brg_DE_NEU, " AND veoant_beznr NOT LIKE 'DU%' AND basman_nl='SUW' ") Dim top_durmaz_at As List(Of topValues) = BRG.getBrgTop5FromFMZOLL_Zabis(monday.ToShortDateString, sunday.ToShortDateString, "50", "60", usrctlBuergschaft.brg_AT, " AND veoant_beznr LIKE 'DU%' AND basman_nl='SUW' ") Dim top_durmaz_de As List(Of topValues) = BRG.getBrgTop5FromFMZOLL_Zabis(monday.ToShortDateString, sunday.ToShortDateString, "50", "60", usrctlBuergschaft.brg_DE, " AND veoant_beznr LIKE 'DU%' AND basman_nl='SUW' ") Dim top_durmaz_de2 As List(Of topValues) = BRG.getBrgTop5FromFMZOLL_Zabis(monday.ToShortDateString, sunday.ToShortDateString, "50", "60", usrctlBuergschaft.brg_DE_NEU, " AND veoant_beznr LIKE 'DU%' AND basman_nl='SUW' ") Dim top_durmaz_de2_DY As List(Of topValues) = BRG.getBrgTop5FromFMZOLL_Zodiak(monday.ToShortDateString, sunday.ToShortDateString, "50", "60", usrctlBuergschaft.brg_DE_NEU, " AND ncts_ObjectName LIKE 'DU%' ") Dim top_atilla_at_zol As List(Of topValues) = BRG.getBrgTop5FromFMZOLL_Zolaris(monday.ToShortDateString, sunday.ToShortDateString, "50", "60", usrctlBuergschaft.brg_AT, " AND OperatorId IN ('5','6') ") Dim exclApp As Object 'as Application Dim Datei As Object 'as WorkBook Dim Blatt As Object 'as WorkSheet exclApp = CreateObject("Excel.Application") Dim nWeek As Integer nWeek = DatePart(DateInterval.WeekOfYear, New Date(2004, 3, 22), FirstDayOfWeek.Monday, FirstWeekOfYear.FirstFourDays) With exclApp .Visible = False 'Dim sPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\Bürgschaften\" ' My.Computer.FileSystem.GetTempFileName 'If Not My.Computer.FileSystem.DirectoryExists(sPath) Then 'My.Computer.FileSystem.CreateDirectory(sPath) 'End If Try My.Computer.FileSystem.WriteAllBytes(sPath & "Auswertung_Atilla_Durmaz.xlsx", My.Resources.ATILLA_DURMAZ, False) Catch ex As System.Exception ' MsgBox(ex.Message) Return "ERROR 01: " & ex.Message & vbNewLine & ex.StackTrace End Try Datei = .Workbooks.Open(sPath & "Auswertung_Atilla_Durmaz.xlsx") 'Anpassen Blatt = Datei.Worksheets("Tabelle1") 'Anpassen 'Blatt.Range("A1").Value = TextBox1.Text Blatt.Range("A2").Value = "KW" & KW Blatt.Range("B2").Value = "( " & monday.ToShortDateString & " - " & sunday.ToShortDateString & " )" ' Blatt.Range("A2").Value = "Bürgschaft AT"" & cboAtillaDurmazKw.Text Blatt.Range("B6").Value = toDec(atilla_sum_at) Blatt.Range("B9").Value = toDec(atilla_sum_at_zol) Blatt.Range("B7").Value = toDec(atilla_sum_de) Blatt.Range("F6").Value = toDec(durmaz_sum_at) Blatt.Range("F7").Value = toDec(durmaz_sum_de) 'NEU: Blatt.Range("B8").Value = toDec(atilla_sum_de2) Blatt.Range("F8").Value = toDec(durmaz_sum_de2) Dim cnt As Integer 'Atilla cnt = 14 For Each da In top_atilla_de Blatt.Range("B" & cnt).Value = toDec(da.warenwert) Blatt.Range("C" & cnt).Value = toDec(da.sicherheitsbetrag) cnt += 1 Next cnt = 19 For Each da In top_atilla_at Blatt.Range("B" & cnt).Value = toDec(da.warenwert) Blatt.Range("C" & cnt).Value = toDec(da.sicherheitsbetrag) cnt += 1 Next cnt = 29 For Each da In top_atilla_de2 Blatt.Range("B" & cnt).Value = toDec(da.warenwert) Blatt.Range("C" & cnt).Value = toDec(da.sicherheitsbetrag) cnt += 1 Next 'Durmaz cnt = 14 For Each da In top_durmaz_de Blatt.Range("F" & cnt).Value = toDec(da.warenwert) Blatt.Range("G" & cnt).Value = toDec(da.sicherheitsbetrag) cnt += 1 Next cnt = 19 For Each da In top_durmaz_at Blatt.Range("F" & cnt).Value = toDec(da.warenwert) Blatt.Range("G" & cnt).Value = toDec(da.sicherheitsbetrag) cnt += 1 Next cnt = 24 For Each da In top_durmaz_de2 Blatt.Range("F" & cnt).Value = toDec(da.warenwert) Blatt.Range("G" & cnt).Value = toDec(da.sicherheitsbetrag) cnt += 1 Next 'Zolaris cnt = 24 For Each da In top_atilla_at_zol Blatt.Range("B" & cnt).Value = toDec(da.warenwert) Blatt.Range("C" & cnt).Value = toDec(da.sicherheitsbetrag) cnt += 1 Next .Visible = visible If visible = False Then Datei.Save() .DisplayAlerts = False .quit() Try : Datei.close(True) : Catch : End Try End If 'End If ' Application.DisplayAlerts = True Return sPath & "Auswertung_Atilla_Durmaz.xlsx" ' Datei.close(True) ' .quit() End With Catch ex As System.Exception ' MsgBox(ex.Message) Return "ERROR 02: " & ex.Message & vbNewLine & ex.StackTrace End Try End Function Public Function getKW(ByVal Datum As Date) As Short Dim CUI As New CultureInfo(CultureInfo.CurrentCulture.Name) Return CUI.Calendar.GetWeekOfYear(Datum, CUI.DateTimeFormat.CalendarWeekRule, CUI.DateTimeFormat.FirstDayOfWeek) End Function Private Function decSum(ByVal s1 As String, ByVal s2 As String, Optional s3 As String = "0") As Decimal Dim d1 As Decimal = 0 Dim d2 As Decimal = 0 Dim d3 As Decimal = 0 Try d1 = CDec(s1) Catch ex As System.Exception : End Try Try d2 = CDec(s2) Catch ex As System.Exception : End Try Try d3 = CDec(s3) Catch ex As System.Exception : End Try Return (d1 + d2 + d3) End Function Private Function cut_file(ByVal file As String) As String ' Funktion zum Entfernen der Backslashs / Ordner While file.Contains("\") file = file.Remove(0, 1) End While Return file End Function While file.Contains("\") file = file.Remove(0, 1) End While Return file End Function Private Function delFiles(ByVal delpfad As String) As Boolean Try For Each file As String In IO.Directory.GetFiles(delpfad) ' Ermittelt alle Dateien des Ordners My.Computer.FileSystem.DeleteFile(file) 'Löscht das Programm Next For Each file As String In IO.Directory.GetDirectories(delpfad) ' Ermittelt alle Dateien des Ordners System.IO.Directory.Delete(file, True) Next Catch ex As Exception MsgBox("ERROR_COPY_03: Fehler beim Löschen", MsgBoxStyle.Critical, "ERROR") Return False End Try Return True End Function Public Sub screenshot() Dim form As New Form form = form.ActiveForm Dim bounds As Rectangle Dim screenshot As System.Drawing.Bitmap Dim graph As Graphics bounds = form.Bounds 'Screen.PrimaryScreen.Bounds screenshot = New System.Drawing.Bitmap(bounds.Width, bounds.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb) graph = Graphics.FromImage(screenshot) graph.CopyFromScreen(bounds.X, bounds.Y, 0, 0, bounds.Size, CopyPixelOperation.SourceCopy) ' PictureBox1.Image = screenshot If Not My.Computer.FileSystem.DirectoryExists(My.Computer.FileSystem.SpecialDirectories.Desktop & "\Screenshots_" & My.Application.Info.AssemblyName & "\") Then My.Computer.FileSystem.CreateDirectory(My.Computer.FileSystem.SpecialDirectories.Desktop & "\Screenshots_" & My.Application.Info.AssemblyName & "\") End If Dim cnt As Integer = 1 Dim strname As String = My.Computer.FileSystem.SpecialDirectories.Desktop & "\Screenshots_" & My.Application.Info.AssemblyName & "\" & form.Name & "_" & Now.ToString("ddMMyyyy_HHmm_") While System.IO.File.Exists(strname & cnt & ".bmp") : cnt += 1 : End While screenshot.Save(strname & cnt & ".bmp") End Sub Public Function getDiff(von As String, bis As String, niederlassung As String, woTagIsSO As Boolean) As Double Dim sum As Double = 0 If von = "" Or bis = "" Then Return 0 End If 'If Not (isValidTime(von) And isValidTime(bis)) Then 'MsgBox("Falsches Format, Zeitberechnung ist fehlerhaft!") ' Return 0 ' End If If von.Contains(":") And von.Length = 5 And bis.Contains(":") And bis.Length = 5 Then If niederlassung = "ATILLA" Then sum += TimeDiff00To06(von, bis) / 60 ' ATILLA - Nacht Überstd. x2 If woTagIsSO Then sum += TimeDiffSO06To24(von, bis) / 60 'VERAG + ATILLA - SONNTAG TAG Überstd. x2 sum += TimeDiff(von, bis) / 60 End If Return sum End Function Public Function TimeDiff(ByVal sTime_von As String, ByVal sTime_bis As String) As Integer ' Uhrzeiten in TimeSpan-Objekte überführen Dim time1 As TimeSpan = TimeSpan.Parse(sTime_von) Dim time2 As TimeSpan = TimeSpan.Parse(sTime_bis) ' Zeitdifferenz in Minuten berechnen Dim nMin As Integer = 0 With time2.Subtract(time1) nMin = .Hours * 60 + .Minutes ' Falls negativ, 24 Stunden hinzuaddieren If nMin < 0 Then nMin += 24 * 60 End With Return (nMin) End Function Public Function TimeDiffSO06To24(ByVal sTime_von As String, ByVal sTime_bis As String) As Integer ' Uhrzeiten in TimeSpan-Objekte überführen Dim time1 As TimeSpan = TimeSpan.Parse(sTime_von) Dim time2 As TimeSpan = TimeSpan.Parse(sTime_bis) ' If time1 > time2 Then 'time2 = TimeSpan.Parse("00:00") 'End If ' Zeitdifferenz in Minuten berechnen Dim nMin As Integer = 0 With time2.Subtract(time1) nMin = .Hours * 60 + .Minutes ' Falls negativ, 24 Stunden hinzuaddieren If nMin < 0 Then nMin += 24 * 60 End With Return (nMin) End Function Function isValidTime(s) As Boolean Dim rgx As New Regex("^\d{2}:\d{2}$") ' If s.ToString.Contains("a") Then MsgBox(s & " - " & rgx.IsMatch(s)) Return rgx.IsMatch(s) End Function Public Function TimeDiff00To06(ByVal sTime1 As String, ByVal sTime2 As String) As Integer ' Uhrzeiten in TimeSpan-Objekte überführen Dim time1VON As TimeSpan = TimeSpan.Parse(sTime1) Dim time2BIS As TimeSpan = TimeSpan.Parse(sTime2) 'Normalzeit If time1VON > TimeSpan.Parse("06:00") And time2BIS > TimeSpan.Parse("06:00") And time2BIS >= time1VON Then Return 0 End If If time1VON <= TimeSpan.Parse("06:00") And time2BIS < TimeSpan.Parse("06:00") Then Return TimeDiff(sTime1, "06:00") + TimeDiff("00:00", sTime2) End If 'Ganze Nacht: If time1VON > TimeSpan.Parse("06:00") And time2BIS > TimeSpan.Parse("06:00") Then time1VON = TimeSpan.Parse("00:00") time2BIS = TimeSpan.Parse("06:00") End If ' If time1VON <= TimeSpan.Parse("06:00") And time2BIS < TimeSpan.Parse("06:00") Then 'Return TimeDiff(sTime1, "06:00") + TimeDiff("00:00", sTime2) ' End If If time1VON > TimeSpan.Parse("06:00") Then time1VON = TimeSpan.Parse("00:00") End If If time2BIS > TimeSpan.Parse("06:00") Then time2BIS = TimeSpan.Parse("06:00") End If ' Zeitdifferenz in Minuten berechnen Dim nMin As Integer = 0 With time2BIS.Subtract(time1VON) nMin = .Hours * 60 + .Minutes ' Falls negativ, 24 Stunden hinzuaddieren If nMin < 0 Then nMin += 24 * 60 End With Return (nMin) End Function Public Function TimeDiff22To06(ByVal sTime1 As String, ByVal sTime2 As String) As Integer ' Uhrzeiten in TimeSpan-Objekte überführen Dim time1VON As TimeSpan = TimeSpan.Parse(sTime1) Dim time2BIS As TimeSpan = TimeSpan.Parse(sTime2) 'Normalzeit If time1VON > TimeSpan.Parse("06:00") And time1VON < TimeSpan.Parse("22:00") And time2BIS > TimeSpan.Parse("06:00") And time2BIS < TimeSpan.Parse("22:00") And time2BIS >= time1VON Then Return 0 End If If time1VON <= TimeSpan.Parse("06:00") And (time2BIS >= TimeSpan.Parse("22:00") Or time2BIS < TimeSpan.Parse("06:00")) Then Return TimeDiff(sTime1, "06:00") + TimeDiff("22:00", sTime2) End If If time1VON > TimeSpan.Parse("06:00") And time1VON < TimeSpan.Parse("22:00") Then time1VON = TimeSpan.Parse("22:00") End If If time2BIS > TimeSpan.Parse("06:00") And time2BIS < TimeSpan.Parse("22:00") Then time2BIS = TimeSpan.Parse("06:00") End If ' Zeitdifferenz in Minuten berechnen Dim nMin As Integer = 0 With time2BIS.Subtract(time1VON) nMin = .Hours * 60 + .Minutes ' Falls negativ, 24 Stunden hinzuaddieren If nMin < 0 Then nMin += 24 * 60 End With Return (nMin) End Function Function getSchicht(aktWoche, aktJahr) As String Dim SCHICHT As String = "" Dim dStart As Date = CalendarWeek(aktWoche, aktJahr) If EvenNumber(dStart) = False Then SCHICHT = "ROT" Else SCHICHT = "BLAU" End If If EvenNumber2(dStart) = False Then SCHICHT &= "1" Else SCHICHT &= "2" End If Return SCHICHT End Function Public Function EvenNumber(aktDate) 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(aktDate) 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 Dim SQLDienst As New cDienstplan Public Function getWochenstunden(STD_LIST As List(Of cDienstMitarbAbweichendeWochenstunden), Wochenstunden As Double, datum As Date, SCHICHT As String, dstma_id As Integer, dstma_muster As Boolean, dstma_WEStdRegelAZ As Boolean, dstma_arbvh As String, niederlassung As String, StdFeiertag As Object, schicht4wo As Boolean) As Double getWochenstunden = cDienstMitarbAbweichendeWochenstunden.GET_STD_LIST(STD_LIST, dstma_id, datum, Wochenstunden, If(StdFeiertag, -1)) Dim UrlStd As Double = 8 If StdFeiertag IsNot Nothing Then UrlStd = StdFeiertag Dim dMa As cDienstMA = SQLDienst.getDstMAByDstMaId(dstma_id) For i = 0 To 6 ' Wochenstunden -= getWochenstundenTAG(datum, SCHICHT, dstma_id, dstma_muster, dstma_WEStdRegelAZ, dstma_arbvh, niederlassung) Dim FT As New VERAG_PROG_ALLGEMEIN.cFeiertage(datum.Year) If FT.isFeiertag(datum, IIf(dMa.dstma_land <> "", dMa.dstma_land, cDienstSettings.getLand(niederlassung))) Or datum.ToString("dd.MM.") = "31.12." Or datum.ToString("dd.MM.") = "24.12." Then 'Feiertag oder 1/2 Tag Dim woTag = datum.ToString("ddd", New CultureInfo("de-DE")).ToUpper If dstma_muster Then 'Wenn Muster, dann muss Feiertag bei VZ und TZ berüchsichtigt werden.... If (woTag <> "SA" And woTag <> "SO") Or dstma_WEStdRegelAZ Then ' ... aber nur wenn Wochendende teil der Regel-Arbeitszeit ist. Dim tz As cDienstTeilzeit = SQLDienst.getDienstTeilzeitBySchicht(dstma_id, SCHICHT, woTag, schicht4wo) If tz IsNot Nothing Then ' EVtl gibt es den WoTag Nicht 'Wochenstunden -= getDiff(tz.dsttz_von, tz.dsttz_bis, niederlassung, (FT.isFeiertag(datum) Or woTag = "SO")) If datum.ToString("dd.MM.") = "31.12." Or datum.ToString("dd.MM.") = "24.12." Then 'Weihnachten und Silvester ist ist nur 1/2 Tag!!! getWochenstunden -= UrlStd / 2 Else If dstma_arbvh = "VZ" Then getWochenstunden -= UrlStd 'bei vollzeit mit Muster werden 8 Std abgezogen Else If StdFeiertag IsNot Nothing Then getWochenstunden -= UrlStd ' wurde oben schon angepasst. Else 'gibt es keine deinierten Std.für einen Feiertag, werden die Stunden nach Mustereinteilung berechnet: If getDiff(tz.dsttz_von, tz.dsttz_bis, niederlassung, False) > 0 Then 'Wenn an deisem Tag Stunden angefallen wären (lt. Muster) Dim getWochenstundenTAG = getDiff(tz.dsttz_von, tz.dsttz_bis, niederlassung, False) If IsNumeric(tz.dsttz_pause) Then getWochenstundenTAG -= tz.dsttz_pause getWochenstunden -= getWochenstundenTAG End If End If End If End If End If End If Else 'If dstma_arbvh = "VZ" And woTag <> "SA" And woTag <> "SO" Then 'Normaler Feiertag bei VZ unter der Woche --> 8 Std. If woTag <> "SA" And woTag <> "SO" Then 'Normaler Feiertag bei VZ unter der Woche --> 8 Std. If datum.ToString("dd.MM.") = "31.12." Or datum.ToString("dd.MM.") = "24.12." Then getWochenstunden -= (UrlStd / 2) Else getWochenstunden -= UrlStd End If End If End If 'tz. 'SQLDienst.getDienstDetailsWoTagByArtAndWoTag(niederlassung, art) End If datum = datum.AddDays(1) Next Return getWochenstunden End Function Public Function getWochenstundenTAG(datum As Date, SCHICHT As String, dstma_id As Integer, dstma_muster As Boolean, dstma_WEStdRegelAZ As Boolean, dstma_arbvh As String, niederlassung As String) As Double Dim FT As New VERAG_PROG_ALLGEMEIN.cFeiertage(datum.Year) Dim woTag = datum.ToString("ddd", New CultureInfo("de-DE")).ToUpper Dim dMa As cDienstMA = SQLDienst.getDstMAByDstMaId(dstma_id) If FT.isFeiertag(datum, IIf(dMa.dstma_land <> "", dMa.dstma_land, cDienstSettings.getLand(niederlassung))) Then 'Feiertag oder 1/2 Tag getWochenstundenTAG = 0 ElseIf woTag = "SA" And woTag = "SO" Then getWochenstundenTAG = 0 Else If datum.ToString("dd.MM.") = "31.12." Or datum.ToString("dd.MM.") = "24.12." Then getWochenstundenTAG = 4 Else getWochenstundenTAG = 8 End If End If Return getWochenstundenTAG 'If False Then ' getWochenstundenTAG = 0 ' Dim FT As New cFeiertage(datum.Year) ' If FT.isFeiertag(datum) Then 'Feiertag oder 1/2 Tag ' getWochenstundenTAG = 0 ' Else ' Dim woTag = datum.ToString("ddd", New CultureInfo("de-DE")).ToUpper ' If dstma_muster Then 'Wenn Muster, dann muss Feiertag bei VZ und TZ berüchsichtigt werden.... ' If (woTag <> "SA" And woTag <> "SO") Or dstma_WEStdRegelAZ Then ' ... aber nur wenn Wochendende teil der Regel-Arbeitszeit ist. ' Dim tz As cDienstTeilzeit = SQLDienst.getDienstTeilzeitBySchicht(dstma_id, SCHICHT, woTag) ' If tz IsNot Nothing Then ' EVtl gibt es den WoTag Nicht ' 'Wochenstunden -= getDiff(tz.dsttz_von, tz.dsttz_bis, niederlassung, (FT.isFeiertag(datum) Or woTag = "SO")) ' If datum.ToString("dd.MM.") = "31.12." Or datum.ToString("dd.MM.") = "24.12." Then 'Weihnachten und Silvester ist ist nur 1/2 Tag!!! ' getWochenstundenTAG = 4 ' Else ' getWochenstundenTAG = getDiff(tz.dsttz_von, tz.dsttz_bis, niederlassung, False) ' If IsNumeric(tz.dsttz_pause) Then getWochenstundenTAG += tz.dsttz_pause ' End If ' End If ' End If ' Else ' If dstma_arbvh = "VZ" And woTag <> "SA" And woTag <> "SO" Then 'Normaler Feiertag bei VZ unter der Woche --> 8 Std. ' If datum.ToString("dd.MM.") = "31.12." Or datum.ToString("dd.MM.") = "24.12." Then ' getWochenstundenTAG = 4 ' Else ' getWochenstundenTAG = 8 ' End If ' End If ' End If ' 'tz. ' 'SQLDienst.getDienstDetailsWoTagByArtAndWoTag(niederlassung, art) ' End If 'End If 'Return getWochenstundenTAG 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.ToString & Format$(dDate.Subtract(dThisYear).Days \ 7 + 1, "00").ToString End If End Function Public Function GetWeekStartDate(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 Public Sub KWAbschluss(STD_LIST, niederlassung, aktJahr, aktWoche, SCHICHT) Try Dim SQLDienst As New cDienstplan ' If Not SQLDienst.existsEntryKWUeberstd(niederlassung, aktJahr, aktWoche) Then Try Dim datum_start As Date = CalendarWeek(aktWoche, aktJahr) Dim datum_end As Date = datum_start.AddDays(6) Dim table As DataTable = SQLDienst.loadDGV("SELECT dstma_abteilung AS ABT, dstma_kuerzel AS NAME,dstma_wochenStunden,dstma_arbvh, dstma_id,dstma_farbe,dstma_mitId,dstma_ueberstdCounter FROM tblDienstMitarb WHERE dstma_niederlassung='" & niederlassung & "' ORDER BY ABT DESC, dstma_arbvh DESC, NAME") Dim cPF As New cProgramFunctions With table For Each r As DataRow In .Rows If SQLDienst.getCountEntrys(r("dstma_id"), datum_start, datum_end) > 0 Then 'nur wenn der MA in dieser Woche Einträge hat.. Dim datum_montag As Date = CalendarWeek(aktWoche, aktJahr) Dim thisMonth As New DateTime(DateTime.Today.Year, DateTime.Today.Month, 1) Dim datum As Date = datum_montag Dim ma As cDienstMA = SQLDienst.getDstMA(r("dstma_id")) Dim Wochenstunden As Double = 0 If IsNumeric(ma.dstma_wochenStunden) Then Wochenstunden = ma.dstma_wochenStunden ' MsgBox(Wochenstunden) Wochenstunden = cPF.getWochenstunden(STD_LIST, Wochenstunden, datum, SCHICHT, r("dstma_id"), ma.dstma_muster, ma.dstma_WEStdRegelAZ, ma.dstma_arbvh, niederlassung, ma.dstma_TzFeiertageStd, ma.dstma_4wo) Dim tatStd As Double = SQLDienst.getDstStunden(r("dstma_id"), datum_montag, datum_montag.AddDays(6), niederlassung, ma.dstma_land) ' : ANDERES ERG"""""!!!!!!!!!!!!!!!!!!!! ' Wochenstunden = cPF.getWochenstunden(Wochenstunden, datum, SCHICHT, r.Cells("dstma_id").Value, ma.dstma_muster, ma.dstma_WEStdRegelAZ, ma.dstma_arbvh, niederlassung) ' Dim tatStd As Double = SQLDienst.getDstStunden(r.Cells("dstma_id").Value, datum_montag, datum_montag.AddDays(6), niederlassung) ' MsgBox(tatStd & " - " & Wochenstunden) ' SQLDienst.updateDienstMaStdADD(r("dstma_id"), (tatStd - Wochenstunden)) If datum_start >= CDate("24.12.2018") Then 'ab hier startet die Zählung SQLDienst.insertupdateDienstplanUeberSdtMa(r("dstma_id"), aktWoche, aktJahr, (tatStd - Wochenstunden), niederlassung) ' MsgBox(r("NAME") & ": " & tatStd & ": " & Wochenstunden) End If End If Next End With ' SQLDienst.insertifExistsDienstKWUeberstd(niederlassung, aktJahr, aktWoche) Catch ex As Exception MsgBox("initStdMa-Error: " & ex.Message) End Try ' Else ' MsgBox("Die Woche wurde bereits abgeschlossen!") ' End If 'MsgBox("OK") Catch ex As Exception End Try End Sub 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 Public Function MessageTimeOut(sMessage As String, sTitle As String, iSeconds As Integer) As Boolean Dim Shell = CreateObject("WScript.Shell") Shell.Run("mshta.exe vbscript:close(CreateObject(""WScript.shell"").Popup(""" & sMessage & """," & iSeconds & ",""" & sTitle & """))") MessageTimeOut = True End Function End Class Public Class SQLVariable Private TextSQLName As String Private ValueSQLVALUE As Object Private Scalarvariablename As String Private primaryParam As Boolean Public Sub New(ByVal Text As String, ByVal Value As Object, Optional Scalarvariablename As String = "", Optional primaryParam As Boolean = False) Me.TextSQLName = Text Me.ValueSQLVALUE = Value Me.primaryParam = primaryParam If Scalarvariablename <> "" Then Me.Scalarvariablename = Scalarvariablename Else Me.Scalarvariablename = Text End Sub Public ReadOnly Property Text() As String Get Return TextSQLName End Get End Property Public ReadOnly Property Value() As Object Get Return ValueSQLVALUE End Get End Property Public ReadOnly Property Scalarvariable() As Object Get Return Scalarvariablename End Get End Property Public ReadOnly Property isPrimaryParam() As Boolean Get Return primaryParam End Get End Property ' Public Overrides Function ToString() As Object ' Return mText ' End Function End Class