This commit is contained in:
2024-05-28 08:53:40 +02:00
parent 78e31b3bc7
commit ddec29fd02
10 changed files with 977 additions and 46 deletions

View File

@@ -2,6 +2,9 @@
Imports Tamir
Imports Tamir.SharpSsh
Imports Microsoft.Office.Interop
Imports Org.BouncyCastle.Crypto.Agreement
Imports VERAG_PROG_ALLGEMEIN
Public Class usrCntlTCeZOLL_EZA
Property ALLG As usrCntlTCeZOLL_EZA_Allg
@@ -574,6 +577,7 @@ Public Class usrCntlTCeZOLL_EZA
TC_ANM.Declarant_TIN = "ATEOS1000059735" 'EORI
cTELOTECInterface_Send.loadInClass_VersandanmeldungEZA(TC_ANM, Me)
If Not TC_ANM.SAVE() Then Exit Sub
@@ -624,6 +628,359 @@ Public Class usrCntlTCeZOLL_EZA
End Sub
Private Function importExcel_trendyol() As Boolean
lblUpload.Text = "Excel öffnen..."
lblUpload.Visible = True
Dim fd As New OpenFileDialog
fd.Filter = "Excel Dateien|*.xls;*.xlsx"
Dim result As DialogResult = fd.ShowDialog()
If Not fd.FileName.EndsWith(".xls") And Not fd.FileName.EndsWith(".xlsx") Then
Me.Cursor = Cursors.Default
lblUpload.Visible = False : Return False
End If
If result = System.Windows.Forms.DialogResult.OK Then
Me.Cursor = Cursors.WaitCursor
Dim exclApp As New Excel.Application 'Object 'as Application
Dim Datei As Excel.Workbook ' 'as WorkBook
Dim Blatt As Excel.Worksheet 'Object 'as WorkSheet
With exclApp
Try
.CutCopyMode = False
.DisplayAlerts = False
Datei = .Workbooks.Open(fd.FileName)
Blatt = Datei.Worksheets(1)
Datei.Activate()
Try
Blatt.ShowAllData() 'Falls Filter ausgewählt wurde
Catch ex As Exception
End Try
Dim startFound As Boolean = False
Dim endFound As Boolean = False
If Not checkExcel_trendyol(Blatt) Then 'VALIDIERUNG
Me.Cursor = Cursors.Default
lblUpload.Visible = False : Return False
End If
If TC_ANM.POSITIONSDATEN.Count > 0 Then
If vbYes = MsgBox("Sollten die aktuellen Einträge gelöscht werden?", vbYesNo) Then
TC_ANM.POSITIONSDATEN.Clear() 'Zurücksetzen
End If
End If
Dim startRows As Integer = 25
Dim endRows As Integer = startRows
While endRows < Blatt.UsedRange.Rows.Count
If Not Blatt.Range("B" & endRows) Is Nothing AndAlso Not Blatt.Range("B" & endRows).Value Is Nothing AndAlso Not Blatt.Range("B" & endRows).Value.ToString.Trim = "" Then
endFound = True
Else
Exit While
End If
endRows += 1
End While
endRows -= 1
If Not endFound Then
MsgBox("Keine Daten vorhanden!")
Me.Cursor = Cursors.Default
lblUpload.Visible = False : Return False
End If
lblUpload.Text = "Daten auslesen..."
'Laden des Bereiches aus dem Excel:
Dim myRange As Excel.Range
myRange = Blatt.Range("B" & startRows & ":N" & endRows & "")
Dim myArray As Object(,) '<-- declared as 2D Array
myArray = myRange.Value 'store the content of each cell
'myArray(i_soll2 - startRows + 1, 4)
lblUpload.Text = "Aggregieren..."
Dim DT = aggregierenTrendxol(myArray)
Dim cnt = 0
Dim sqlTest = "SELECT ezt_Codenummer,case when ezt_text Like '%für Frauen%' then 'Damen' when ezt_text Like '%für Männer%' THEN 'HERREN' ELSE '' END,
case
when ezt_text Like '%aus synthetischen Chemiefasern%' then ', aus synthetischen Chemiefasern'
when ezt_text Like '%Gewirken oder Gestricken%' then ', gewirkt oder gestickt'
when ezt_text Like '%aus Kunststoff%' THEN ', aus Kunststoff'
ELSE '' END,
ezt_text
FROM [VERAG].[dbo].[tblEZT_Importcodenummern]
where ezt_Codenummer LIKE '6206400000%'
"
lblUpload.Text = "Laden & Übersetzen..."
If DT IsNot Nothing Then
Try
For Each row As DataRow In DT.Rows
Dim POSITION As New TELOTEC_Worker.cTelotec_Positionsdaten
POSITION.Item_ComCd = row("Tariff").ToString().Replace(".", "")
POSITION.PACKSTUECKE.Clear()
Dim PK As New TELOTEC_Worker.cTelotec_Packstuecke
PK.Pack_Kind = "PK"
PK.Pack_Nr = row("SumQty").ToString()
POSITION.PACKSTUECKE.Add(PK)
If row("Currency") = "EUR" Then
POSITION.Item_ItVal = CDbl(row("SumAmount").ToString()).ToString("N2")
End If
Dim desc = row("Description").ToString
cDeeplAPI.deepl_Translate(row("Description").ToString, desc, "DE", "EN")
POSITION.Item_GdsDes = desc
POSITION.Item_Orig = row("Origin").ToString()
TC_ANM.POSITIONSDATEN.Add(POSITION)
cnt += 1
Next
'For i As Integer = 1 To endRows - startRows + 1 Step 1
' Dim POSITION As New TELOTEC_Worker.cTelotec_Positionsdaten
' POSITION.Item_ComCd = myArray(i, 6).ToString().Replace(".", "")
' POSITION.PACKSTUECKE.Clear()
' Dim PK As New TELOTEC_Worker.cTelotec_Packstuecke
' PK.Pack_Kind = "PK"
' PK.Pack_Nr = myArray(i, 8).ToString()
' POSITION.PACKSTUECKE.Add(PK)
' If myArray(i, 13).ToString() = "EUR" Then
' POSITION.Item_ItVal = CDbl(myArray(i, 12).ToString()).ToString("N2")
' End If
' POSITION.Item_GdsDes = myArray(i, 5).ToString()
' POSITION.Item_Orig = myArray(i, 4).ToString()
' TC_ANM.POSITIONSDATEN.Add(POSITION)
' cnt += 1
'Next
Catch ex As Exception
MsgBox("Fehler beim Einlesen der Excel-Datei!" & vbNewLine & vbNewLine & ex.Message & ex.StackTrace)
Datei.Close()
Me.Cursor = Cursors.Default
lblUpload.Visible = False : Return False
End Try
End If
.Visible = False
Datei.Close()
Me.FindForm.SuspendLayout()
' POSITIONEN.setValues(TC_ANM)
ALLG.setPosValues(TC_ANM)
btnPositionen.PerformClick()
' MsgBox(cnt & " Datensätze wurden eingelesen. ")
Me.FindForm.ResumeLayout()
lblUpload.Text = "Fertig! " & cnt & " Datensätze wurden eingelesen. "
Me.Cursor = Cursors.Default
Return True
Catch ex As Exception
'
Me.Cursor = Cursors.Default
MsgBox("FEHLER! Datei im richtigen Format?" & vbNewLine & vbNewLine & ex.Message & ex.StackTrace)
lblUpload.Visible = False
' Return False
End Try
End With
Return True
Else
MsgBox("Keine Datei ausgewählt!")
End If
Me.Cursor = Cursors.Default
lblUpload.Visible = False
Return False
End Function
Sub CreateDataTable(ByRef DT As DataTable)
'DT.Columns.Add("A")
DT.Columns.Add("B")
DT.Columns.Add("C")
DT.Columns.Add("D")
DT.Columns.Add("E")
DT.Columns.Add("F")
DT.Columns.Add("G")
DT.Columns.Add("H")
DT.Columns.Add("I", System.Type.GetType("System.Int32"))
DT.Columns.Add("J")
DT.Columns.Add("K")
DT.Columns.Add("L")
DT.Columns.Add("M", System.Type.GetType("System.Decimal"))
DT.Columns.Add("N")
End Sub
Sub CreateDataTableAgg(ByRef DT As DataTable)
'DT.Columns.Add("A")
DT.Columns.Add("Description")
DT.Columns.Add("Tariff")
DT.Columns.Add("Currency")
DT.Columns.Add("Origin")
DT.Columns.Add("SumQty")
DT.Columns.Add("SumAmount")
End Sub
Function aggregierenTrendxol(myArray) As DataTable
Try
Dim DT As DataTable = New DataTable()
Call CreateDataTable(DT) 'Create the DataTable and all Columns
'Add the 2D Array to the DataTable
For i As Integer = 1 To myArray.GetUpperBound(0)
DT.Rows.Add()
For j As Integer = 1 To myArray.GetUpperBound(1)
'If j = 8 Then
' DT.Rows(i - 1).Item(j - 1) = CInt(myArray(i, j))
'Else
' DT.Rows(i - 1).Item(j - 1) = myArray(i, j)
'End If
DT.Rows(i - 1).Item(j - 1) = myArray(i, j)
Next j
Next i
' MsgBox(DT.Rows.Count)
'Dim amountGrpByDates = From row In DT
' Group row By dateGroup = New With {
' Key .Yr = row.Field(Of Integer)("Yr"),
' Key .Mnth = row.Field(Of Integer)("Mnth"),
' Key .Period = row.Field(Of String)("Period")
' } Into Group
' Select New With {
' Key .Dates = dateGroup,
' .SumAmount = Group.Sum(Function(x) x.Field(Of Decimal)("Amount"))}
'For Each r In DT.Rows
' '' MsgBox("a> " & r("A"))
' 'MsgBox("b> " & r("B"))
' 'MsgBox("c> " & r("C"))
' 'MsgBox("d> " & r("D"))
' 'MsgBox("e> " & r("E"))
' 'MsgBox("f> " & r("F"))
' 'MsgBox("g> " & r("G"))
' 'MsgBox("h> " & r("H"))
' MsgBox("i> " & r("I"))
'Next
Dim amountGrpByDates = From row In DT
Group row By groupKeys = New With {
Key .Orig = row.Field(Of String)("E"),
Key .Description = row.Field(Of String)("D") & ", " & row.Field(Of String)("F"),
Key .Tnr = row.Field(Of String)("G"),
Key .Curr = row.Field(Of String)("N")
} Into Group
Select New With {
Key .Params = groupKeys,
.SumQTY = Group.Sum(Function(x) x.Field(Of Integer)("I")),
.SumAmount = Group.Sum(Function(x) x.Field(Of Decimal)("M"))}
' .SumQTY = Group.Sum(Function(x) x.Field(Of Integer)("I"))}
Dim DT_AGG As New DataTable
Call CreateDataTableAgg(DT_AGG) 'Create the DataTable and all Columns
For Each grp In amountGrpByDates
'Dim row As New DataRow
'MsgBox("" & grp.Params.Orig & " " & grp.Params.Description & " " & grp.Params.Tnr & " " & grp.Params.Curr & "= " & grp.SumQTY & " " & grp.SumAmount & "")
DT_AGG.Rows.Add({grp.Params.Description, grp.Params.Tnr, grp.Params.Curr, grp.Params.Orig, grp.SumQTY, grp.SumAmount})
Next
'DT.AsEnumerable().GroupBy(row >= row.Field < Int() > ("G"))
'Dim myArrayAgg As Object(,) '<-- declared as 2D Array
'For iOuter As Integer = myArray.GetLowerBound(0) To myArray.GetUpperBound(0)
' 'iOuter represents the first dimension
' MsgBox(myArray(iOuter, 6))
' 'For iInner As Integer = myArray.GetLowerBound(1) To myArray.GetUpperBound(1)
' ' 'iInner represents the second dimension
' ' myArray(iOuter, iInner) = "This Isn't Nothing" 'Set the value
' 'Next 'iInner
' 'If you are only interested in the first element you don't need the inner loop
' myArray(iOuter, 0) = "This is the first element in the second dimension"
'Next 'iOuter
'MasterIndex is now filled completely
'For i As Integer = 1 To endRows - startRows + 1 Step 1
' Dim POSITION As New TELOTEC_Worker.cTelotec_Positionsdaten
' POSITION.Item_ComCd = myArray(i, 6).ToString().Replace(".", "")
' POSITION.PACKSTUECKE.Clear()
' Dim PK As New TELOTEC_Worker.cTelotec_Packstuecke
' PK.Pack_Kind = "PK"
' PK.Pack_Nr = myArray(i, 8).ToString()
' POSITION.PACKSTUECKE.Add(PK)
' If myArray(i, 13).ToString() = "EUR" Then
' POSITION.Item_ItVal = CDbl(myArray(i, 12).ToString()).ToString("N2")
' End If
' POSITION.Item_GdsDes = myArray(i, 5).ToString()
' POSITION.Item_Orig = myArray(i, 4).ToString()
' TC_ANM.POSITIONSDATEN.Add(POSITION)
' cnt += 1
'Next
Return DT_AGG
Catch ex As Exception
MsgBox("Fehler beim Aggregieren !" & vbNewLine & vbNewLine & ex.Message & ex.StackTrace)
Me.Cursor = Cursors.Default
Return Nothing
End Try
End Function
Private Function checkExcel_trendyol(Blatt As Excel.Worksheet) As Boolean
'Prüfung
Try
If Blatt Is Nothing Then Return False
If Blatt.Range("B24") Is Nothing Then Return False
If Blatt.Range("B24").Value.ToString <> "DESCRIPTION" Then Return False
Catch ex As Exception
MsgBox("Fehler bei der Prüfung!" & ex.Message)
Me.Cursor = Cursors.Default
Return False
End Try
Return True
End Function
Private Sub NeueBezugsnummerVergebenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles NeueBezugsnummerVergebenToolStripMenuItem.Click
@@ -635,5 +992,9 @@ Public Class usrCntlTCeZOLL_EZA
MsgBox(TC_ANM.telanm_id)
End If
End Sub
Private Sub DynamicAutomotiveXLSToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles DynamicAutomotiveXLSToolStripMenuItem.Click
importExcel_trendyol()
End Sub
End Class