1188 lines
56 KiB
VB.net
1188 lines
56 KiB
VB.net
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)
|
|
|
|
' : 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 |