edv/ADMIN
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
fa670231f7a6149ea4afe1d4a8986a0373aaaa28
ADMIN/UID/cProgramFunctions.vb
Andreas Luxbauer fa670231f7 neu
2020-10-02 10:36:37 +02:00

1169 lines
53 KiB
VB.net
Raw Blame History

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"
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 String = BRG.getBrgSumFromFMZOLL_Zabis(datvon.ToShortDateString, datvon.ToShortDateString, "50", "60", brg_AT)
AtWoche_atlas += BRG.getBrgSumFromFMZOLL_Zodiak(datvon.ToShortDateString, datvon.ToShortDateString, "50", "60", brg_AT) ' DATEN AUS DAKOSY/ZODIAK EINLESEN
Dim DeWoche As String = BRG.getBrgSumFromFMZOLL_Zabis(datvon.ToShortDateString, datvon.ToShortDateString, "50", "60", brg_DE)
'DeWoche += BRG.getBrgSumFromFMZOLL_Zodiak(datvon.ToShortDateString, datvon.ToShortDateString, "50", "60", brg_DE)
Dim De2Woche As String = BRG.getBrgSumFromFMZOLL_Zabis(datvon.ToShortDateString, datvon.ToShortDateString, "50", "60", brg_DE_NEU)
De2Woche += BRG.getBrgSumFromFMZOLL_Zodiak(datvon.ToShortDateString, datvon.ToShortDateString, "50", "60", brg_DE_NEU) ' DATEN AUS DAKOSY/ZODIAK EINLESEN
' MsgBox(BRG.getBrgSumFromFMZOLL_Zodiak(datvon.ToShortDateString, datvon.ToShortDateString, "50", "60", brg_DE_NEU))
' Dim test As Double = BRG.getBrgSumFromFMZOLL_Zabis(datvon.ToShortDateString, datvon.ToShortDateString, "50", "60", brg_DE_NEU)
Dim AtWoche_zolaris As String = 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(datvon.ToShortDateString & " AtWoche_atlas: " & AtWoche_atlas)
' MsgBox(datvon.ToShortDateString & ": " & AtWoche_atlas & " - " & DeWoche & " - " & AtWoche_zolaris)
'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 =
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)
buergschaft.brg_de_tag_atlas = BRG.getBrgSumFromFMZOLL_Zabis(datvon.AddMonths(-3).ToShortDateString, datvon.ToShortDateString, "50", "50", brg_DE)
buergschaft.brg_at_tag_atlas =
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)
buergschaft.brg_at_tag_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(buergschaft.brg_at_tag_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 = "" 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) 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
For i = 0 To 6
' Wochenstunden -= getWochenstundenTAG(datum, SCHICHT, dstma_id, dstma_muster, dstma_WEStdRegelAZ, dstma_arbvh, niederlassung)
Dim FT As New cFeiertage(datum.Year)
If FT.isFeiertag(datum, 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)
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 getDiff(tz.dsttz_von, tz.dsttz_bis, niederlassung, False) > 0 Then 'Wenn an deisem Tag Stunden angefallen wären (lt. Muster)
getWochenstunden -= UrlStd
' getWochenstunden -= getDiff(tz.dsttz_von, tz.dsttz_bis, niederlassung, False)
' If IsNumeric(tz.dsttz_pause) Then getWochenstunden += tz.dsttz_pause
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 cFeiertage(datum.Year)
Dim woTag = datum.ToString("ddd", New CultureInfo("de-DE")).ToUpper
If FT.isFeiertag(datum, 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 & Format$(dDate.Subtract(dThisYear).Days \ 7 + 1, "00")
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)
Dim tatStd As Double = SQLDienst.getDstStunden(r("dstma_id"), datum_montag, datum_montag.AddDays(6), niederlassung)
' : 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
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
Reference in New Issue View Git Blame Copy Permalink