AppStd/Skriptentwickung
8
0
Fork 0
Code Activity

Anlage des Repos

Browse Source
This commit is contained in:
KammM
2024-01-24 16:42:38 +01:00
commit 38d6a271c4
1785 changed files with 3051496 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/EXIM-Packtisch.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 64 KiB

18
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/AddDebugLine.vbs Normal file
View File

@@ -0,0 +1,18 @@
' AddDebugLine(Message: String)
' ----------------------------------------------------------------------------
' Fügt der DEBUG_MESSAGE eine neue Zeile hinzu
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 20.08.2020 / XX
' Version Date / Editor: 20.08.2020 / XX
' Version Number: 1.0.0.0
Sub AddDebugLine(Message)
DEBUG_MESSAGE = DEBUG_MESSAGE & Message & vbNewLine
End Sub

19
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/AddTwoDimArrayRow.vbm Normal file
View File

@@ -0,0 +1,19 @@
' AddTwoDimArrayRow(arr: Array)
' ----------------------------------------------------------------------------
' Fügt an ein zweidimensionales Array eine Zeile an.
' Wichtig: Die Spalten müssen die erste Dimension sein!
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 18.02.2021 / JJ
' Version Date / Editor: 18.02.2021 / JJ
' Version Number: 3.0.0.0
Sub AddTwoDimArrayRow(Byref arr)
ReDim Preserve arr(UBound(arr, 1), UBound(arr, 2) + 1)
End Sub

49
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/ConvertFromSecureString.vbs Normal file
View File

@@ -0,0 +1,49 @@
' ConvertFromSecureString(Ciphertext : String)
' ----------------------------------------------------------------------------
' Gibt den entschlüsselten String zurück
'
' Source: https://gist.github.com/albert1205/c8430b5bfa505f9308e4fa789b9b1d7f
'
' Returns: ConvertFromSecureString : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 26.08.2020 / XX
' Version Date / Editor: 26.08.2020 / XX
' Version Number: 1.0.0.0
Public Function ConvertFromSecureString(Ciphertext)
Const offset = 10
Const minAsc = 33
Const maxAsc = 126
If Len(Ciphertext) < 5 Then
Decrypt = ""
Exit Function
End If
Dim Plaintext
Ciphertext = Mid(Ciphertext,3,Len(Ciphertext)-4)
For i=2 To Len(Ciphertext) Step 2
oldAsc = Asc(Mid(Ciphertext,i,1)) + offset
If oldAsc > maxAsc Then
oldAsc = oldAsc - maxAsc + minAsc - 1
End If
Plaintext = Plaintext & Chr(oldAsc)
' MsgBox Asc(Mid(Ciphertext,i,1)) & " -> " & oldAsc
Next
ConvertFromSecureString = Plaintext
End Function
Private Sub DecryptTool()
Ciphertext = InputBox("Bitte den zu entschluesselnden String eingeben:", "Eingabe erfolderlich","")
Plaintext = ConvertFromSecureString(Ciphertext)
InputBox "Ihre Eingabe lautete: " & Ciphertext & vbNewLine & vbNewLine & "Entschluesselt, sieht der String wie folgt aus:","Erledigt!",Plaintext
End Sub

55
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/ConvertToSecureString.vbs Normal file
View File

@@ -0,0 +1,55 @@
' ConvertToSecureString(Plaintext : String)
' ----------------------------------------------------------------------------
' Verschlüsselt einen String
'
' Source: https://gist.github.com/albert1205/c8430b5bfa505f9308e4fa789b9b1d7f
'
' Returns: ConvertToSecureString : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 26.08.2020 / XX
' Version Date / Editor: 26.08.2020 / XX
' Version Number: 1.0.0.0
Public Function ConvertToSecureString(Plaintext)
Const offset = 10
Const minAsc = 33
Const maxAsc = 126
Dim Ciphertext
Randomize
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
For i=1 To Len(Plaintext)*2
If i mod 2 = 0 Then
newAsc = Asc(Mid(Plaintext,i/2,1)) - offset
If newAsc < minAsc Then
newAsc = newAsc + maxAsc - minAsc + 1
End If
Ciphertext = Ciphertext & Chr(newAsc)
' MsgBox Asc(Mid(Plaintext,i/2,1)) & " -> " & newAsc
Else
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
' MsgBox "Rnd:" & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
End If
Next
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
ConvertToSecureString = Ciphertext
End Function
Private Sub EncryptTool()
Plaintext = InputBox("Bitte den zu verschluesselnden String eingeben:","Eingabe erfolderlich","")
Ciphertext = ConvertToSecureString(Plaintext)
InputBox "Ihre Eingabe lautete: " & Plaintext & vbNewLine & vbNewLine & "Verschluesselt, sieht der String wie folgt aus:","Erledigt!",Ciphertext
End Sub
Call EncryptTool

18
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/GetLeftPad.vbs Normal file
View File

@@ -0,0 +1,18 @@
' GetLeftPad(Value)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: GetLeftPad : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 10.08.2020 / MK
' Version Date / Editor: 10.08.2020 / MK
' Version Number: 1.0.0.0
Function GetLeftPad(Value)
GetLeftPad = Right("0" & Value, 2)
End Function

83
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/GetWinLineDocDeliveryNoteByUnsplittedProducts.vbs Normal file
View File

@@ -0,0 +1,83 @@
' GetWinLineDocDeliveryNoteByUnsplittedProducts(ProductNumber : String, WinLineMandatorNr : String, WinLineYear : Int)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: NAME : TYP
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 15.09.2020 / JJ
' Version Date / Editor: 15.09.2020 / JJ
' Version Number: 1.0.0.0
Function GetWinLineDocDeliveryNoteByUnsplittedProducts(ProductNumber, WinLineMandatorNr, WinLineYear)
Dim Conn, Result
Set Conn = CWLStart.CurrentCompany.Connection
If (ProductNumber <> "") and (WinLineMandatorNr <> "") and (WinLineYear <> "") Then
'c999 = cOrdnerNr
'c998 = cInvoiceNr
'c997 = KeyValue
'c996 = KeyValue
'MESOPRIM = MESOPRIM
'c995 = Amount / Pos
'c994 = Amount / overall
SQL = ""
SQL = SQL & "SELECT t025.c045 as [c999], t025.c055 as [c998], T026.C000 as [c997], T025.C000 as [c996], T024.MESOPRIM, t026.c006 as [c995], "
SQL = SQL & "( "
SQL = SQL & "SELECT sum(t026.c006) "
SQL = SQL & "FROM T026 WITH (NOLOCK), T025 WITH (NOLOCK), T024 WITH (NOLOCK) "
SQL = SQL & "WHERE T026.MESOCOMP = '"& WinLineMandatorNr &"' AND T025.MESOCOMP = '"& WinLineMandatorNr &"' AND T024.MESOYEAR = '"& WinLineCurrentYear &"' AND T024.MESOCOMP = '"& WinLineMandatorNr &"' "
SQL = SQL & "AND (T025.C021 = T026.C044 AND T025.C022 = T026.C045 AND T025.C137 = 3 AND T026.C042 = N'1' AND T026.C055 < 10 AND T026.C074 < 10 AND T025.C186 = 0 AND T026.C003 = T024.C002 "
SQL = SQL & "AND (T025.C025 = N'D' OR T025.C025 =N'*' OR T025.C026 = N'D' OR T025.C026 =N'*') "
SQL = SQL & "AND (T026.C039 = N'D' OR T026.C039 =N'*' OR T026.C040 = N'D' OR T026.C040 =N'*') "
SQL = SQL & "AND T026.C006 <> 0.0 AND T026.C109 <= 0 AND T026.C003 >= '"& ProductNumber &"' AND T026.C003 <= N'TT1111001') "
SQL = SQL & ") as [c994] "
SQL = SQL & "FROM T026 WITH (NOLOCK), T025 WITH (NOLOCK), T024 WITH (NOLOCK) "
SQL = SQL & "WHERE T026.MESOCOMP = '"& WinLineMandatorNr &"' AND T025.MESOCOMP = '"& WinLineMandatorNr &"' AND T024.MESOYEAR = '"& WinLineCurrentYear &"' AND T024.MESOCOMP = '"& WinLineMandatorNr &"' "
SQL = SQL & "AND (T025.C021 = T026.C044 AND T025.C022 = T026.C045 AND T025.C137 = 3 AND T026.C042 = N'1' AND T026.C055 < 10 AND T026.C074 < 10 AND T025.C186 = 0 AND T026.C003 = T024.C002 "
SQL = SQL & "AND (T025.C025 = N'D' OR T025.C025 =N'*' OR T025.C026 = N'D' OR T025.C026 =N'*') "
SQL = SQL & "AND (T026.C039 = N'D' OR T026.C039 =N'*' OR T026.C040 = N'D' OR T026.C040 =N'*') "
SQL = SQL & "AND T026.C006 <> 0.0 AND T026.C109 <= 0 AND T026.C003 >= '"& ProductNumber &"' AND T026.C003 <= '"& ProductNumber &"' ) "
SQL = SQL & "ORDER BY T026.C003 ASC, T026.C025, T026.C044, T026.C045 "
'MsgBox "SQL (Part 1): " & Mid(SQL, 1, 750)
'MsgBox "SQL (Part 2): " & Mid(SQL, 750)
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for unsplitted delivery notes.. " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL (Part 1): " & Mid(SQL, 1, 750)
AddDebugLine "SQL (Part 2): " & Mid(SQL, 750)
ShowDebugBox "GetWinLineInternalProductNumber"
End If
'Use the set order, because we want to return an object!
Set GetWinLineDocDeliveryNoteByUnsplittedProducts = Result
Else
If DEBUG_ON = True Then
AddDebugLine "Invalid argument call!" & vbNewline
ShowDebugBox "GetWinLineInternalProductNumber"
End If
GetWinLineDocDeliveryNoteByUnsplittedProducts = 0
End If
End Function

281
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/GetWinLineDocInfoByAccountAndRunningNr.vbs Normal file
View File

@@ -0,0 +1,281 @@
' GetWinLineDocInfoByAccountAndRunningNr(DocAccountAndRunningNr : String, PostingType : String, WinLineDocType : String)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: GetWinLineDocInfoByAccountAndRunningNr : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 08.01.2021 / XX
' Version Date / Editor: 08.01.2021 / XX
' Version Number: 1.0.0.0
Function GetWinLineDocInfoByAccountAndRunningNr(DocAccountAndRunningNr, PostingType, WinLineDocType)
On Error Resume Next
'Set SQL Table and Query for DocHead. Default: "T025"
SQLTable_DocHead = "[T025]"
SQLQuery_DocHead = "c000 = '" & DocAccountAndRunningNr & "'" & SQLQuery_OrderWhere
'Set SQL Table and Query for DocMid. Default: "T026"
SQLTable_DocMid = "[T026]"
SQLQuery_DocMid_MengeGeliefert = ""
SQLQuery_DocMid_MengeGeliefert = SQLQuery_DocMid_MengeGeliefert & "SELECT SUM(c006) as [MengeGeliefert] "
SQLQuery_DocMid_MengeGeliefert = SQLQuery_DocMid_MengeGeliefert & "FROM " & SQLTable_DocMid & "(NOLOCK) "
SQLQuery_DocMid_MengeGeliefert = SQLQuery_DocMid_MengeGeliefert & "WHERE [c000] LIKE '" & DocAccountAndRunningNr & "-%'" & SQLQuery_OrderWhere
SQLQuery_DocMid_Rueckstandsmenge = ""
SQLQuery_DocMid_Rueckstandsmenge = SQLQuery_DocMid_Rueckstandsmenge & "SELECT SUM(c099) as [RueckstandsMenge] "
SQLQuery_DocMid_Rueckstandsmenge = SQLQuery_DocMid_Rueckstandsmenge & "FROM " & SQLTable_DocMid & "(NOLOCK) "
SQLQuery_DocMid_Rueckstandsmenge = SQLQuery_DocMid_Rueckstandsmenge & "WHERE [c000] LIKE '" & DocAccountAndRunningNr & "-%'" & SQLQuery_OrderWhere
IF (SQLTable_DocHead <> "") and (SQLQuery_DocHead <> "") and (PostingType <> "") and (WinLineDocType <> "") Then
Set SQLResult_DocHead = CWLStart.CurrentCompany.SearchRecord (SQLTable_DocHead, SQLQuery_DocHead)
If Err.Number <> 0 Then
MSGBOX "Error Code: "& Err.Number & vbCrlf & _
"Error Description: "& Err.Description,,"ERROR: Function GetWinLineDocInfoByAccountAndRunningNr Getting DocHead from DB Table "& SQLTable_DocHead
Err.Clear
Else
'If no line results
If SQLResult_DocHead.RowCount = -1 Then
If DebugMode = "Enabled" Then
MSGBOX "No Rows found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table "& SQLTable_DocHead
End If
Elseif SQLResult_DocHead.RowCount = 1 Then
If DebugMode = "Enabled" Then
MSGBOX "One Row found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table "& SQLTable_DocHead
End If
'Unique Key
DocAccountAndRunningNr = SQLResult_DocHead.value(0)
'Laufnumemr
DocRunningNr = SQLResult_DocHead.value(21)
'Druckstatus Angebot / Anfrage
DocPrintState1 = SQLResult_DocHead.value(22)
'Druckstatus Auftrag / Bestellung
DocPrintState2 = SQLResult_DocHead.value(23)
'Druckstatus Lieferschein
DocPrintState3 = SQLResult_DocHead.value(24)
'Druckstatus Rechnung
DocPrintState4 = SQLResult_DocHead.value(25)
'Number of the Offer ("Angebot")
DocOfferNr = SQLResult_DocHead.value(41)
'Number of the Order ("Angebot")
DocOrderNr = SQLResult_DocHead.value(42)
'Number of delivery note ("Lieferschein")
DocDeliveryNoteNr = SQLResult_DocHead.value(43)
'Number of the Invoice ("Rechung")
DocInvoiceNr = SQLResult_DocHead.value(52)
'When the doc ("Beleg") was created
DocCreated = SQLResult_DocHead.value(56)
'When the doc ("Beleg") was last changed
DocLastChange = SQLResult_DocHead.value(57)
'The ten "Belegkopfnotizen"
DocHeadText1 = SQLResult_DocHead.value(59)
DocHeadText2 = SQLResult_DocHead.value(60)
DocHeadText3 = SQLResult_DocHead.value(61)
DocHeadText4 = SQLResult_DocHead.value(62)
DocHeadText5 = SQLResult_DocHead.value(63)
DocHeadText6 = SQLResult_DocHead.value(64)
DocHeadText7 = SQLResult_DocHead.value(65)
DocHeadText8 = SQLResult_DocHead.value(66)
DocHeadText9 = SQLResult_DocHead.value(67)
DocHeadText10 = SQLResult_DocHead.value(68)
'The current type (1= Anfrage/Angebot; 2= Auftrag/Bestellung; 3= Lieferschein; 4=Rechnung)
DocType = SQLResult_DocHead.value(134)
DocComment = SQLResult_DocHead.value(163)
'msgbox SQLQuery_DocMid_MengeGeliefert
'msgbox SQLQuery_DocMid_RueckstandsMenge
Set SQLResult_DocMid_MengeGeliefert = CWLStart.CurrentCompany.Connection.Select(SQLQuery_DocMid_MengeGeliefert)
'msgbox SQLResult_DocMid_MengeGeliefert.value("MengeGeliefert")
Set SQLResult_DocMid_RueckstandsMenge = CWLStart.CurrentCompany.Connection.Select(SQLQuery_DocMid_RueckstandsMenge)
'msgbox SQLResult_DocMid_RueckstandsMenge.value("RueckstandsMenge")
IF DebugMode = "Enabled" THEN
End if
DocBackOrder = SQLResult_DocMid_RueckstandsMenge.value("RueckstandsMenge")
'msgbox SQLResult_DocMid_Rueckstandsmenge.value("RueckstandsMenge")
IF (PostingType = 1) Then
'If doc = "Angebot" or "Angebots-storno"
IF (WinLineDocType = 1) or (WinLineDocType = 11) then
DocNr = DocOfferNr
IF (WinLineDocType = 1) then
WinLineDocType = "Angebot (debitorisch)"
ElseIF (WinLineDocType = 11) then
WinLineDocType = "Angebot-Storno (debitorisch)"
End If
'If doc = "Auftrag" or "Auftrag-storno"
ElseIf (WinLineDocType = 2) or (WinLineDocType = 12) then
DocNr = DocOrderNr
IF (WinLineDocType = 2) then
WinLineDocType = "Auftrag (debitorisch)"
ElseIF (WinLineDocType = 12) then
WinLineDocType = "Auftrag-Storno (debitorisch)"
End If
'If doc = "Lieferschein" or "Lieferschein-storno" or "Teillieferschein"
ElseIf (WinLineDocType = 3) or (WinLineDocType = 13) or (WinLineDocType = -3) then
DocNr = DocDeliveryNoteNr
IF (DocBackOrder = 0) and (DocPrintState3 <> "L") then
WinLineDocType = "Lieferschein (debitorisch)"
ElseIF (DocBackOrder = 0) and (DocPrintState3 = "L") then
WinLineDocType = "Lieferschein-Storno (debitorisch)"
ElseIF (DocBackOrder <> 0) and (DocPrintState3 <> "L") then
WinLineDocType = "Teillieferschein (debitorisch)"
ElseIF (DocBackOrder <> 0) and (DocPrintState3 = "L") then
'Über die DB Werte ist eine Unterscheidung zwischen Lieferschein und Teillieferschein Storno nicht möglich!
WinLineDocType = "Teillieferschein-Storno (debitorisch)"
End If
'If doc = "Rechnung" or "Rechnungs-storno"
ElseIf (WinLineDocType = 4) or (WinLineDocType = 14) then
DocNr = DocInvoiceNr
IF (WinLineDocType = 4) and (DocPrintState4 <> "L") then
WinLineDocType = "Rechnung (debitorisch)"
ElseIF (WinLineDocType = 4) and (DocPrintState4 = "L") then
WinLineDocType = "Rechnung-Storno (debitorisch)"
ElseIF (WinLineDocType = 14) and (DocPrintState4 = "L") then
WinLineDocType = "Rechnung-Storno (debitorisch)"
End If
Else
IF DebugMode = "Enabled" THEN
MSGBOX "WinLineDocType is not configured!" & vbCrLf & _
"WinLineDocType: " & WinLineDocType, , "DEBUG - Info: Export Metadata"
END IF
End if
ElseIf (PostingType = 2) Then
'not implement
End if
'Array for the function to return
DIM DocInfo(250)
'Items like T25 c000 to c188
DocInfo(59) = DocCreated
DocInfo(60) = DocLastChange
DocInfo(63) = DocHeadText1
DocInfo(64) = DocHeadText2
DocInfo(65) = DocHeadText3
DocInfo(66) = DocHeadText4
DocInfo(67) = DocHeadText5
DocInfo(68) = DocHeadText6
DocInfo(69) = DocHeadText7
DocInfo(70) = DocHeadText8
DocInfo(71) = DocHeadText9
DocInfo(72) = DocHeadText10
DocInfo(139) = DocType
DocInfo(165) = DocComment
'Items beyond T25
DocInfo(200) = WinLineDocType
DocInfo(201) = DocNr
IF DebugMode = "Enabled" THEN
CRLF = chr(13)&chr(10)
msg = "Parameter:" & CRLF
For i = 0 To Ubound(DocInfo)
If (DocInfo(i) <> "") then
msg = msg & i & ".: " & DocInfo(i) & CRLF
end if
Next
msgbox msg ,, "Macro Name: " & CWLMacro.MName
End if
GetWinLineDocInfoByAccountAndRunningNr = DocInfo
Else
If DebugMode = "Enabled" Then
MSGBOX "To many Rows found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNr DocHead from Database table "& SQLTable_DocHead
End If
GetWinLineDocInfoByAccountAndRunningNr = ""
End If
End If
Else
If DebugMode = "Enabled" Then
MSGBOX "Missing Parameter values, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table " & SQLTable_DocHead
End If
GetWinLineDocInfoByAccountAndRunningNr = ""
End If
End Function

103
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/GetWinLineDocUniqueByNumber.vbs Normal file
View File

@@ -0,0 +1,103 @@
' GetWinLineDocUniqueIdentifier(GetWinLineDocUniqueIdentifierParams)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: NAME : TYP
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.12.2020 / MK
' Version Date / Editor: 01.12.2020 / MK
' Version Number: 1.0.0.0
Function GetWinLineDocUniqueIdentifier(GetWinLineDocUniqueIdentifierParams)
'SYNOPSIS
'Function will load external - additional - VBS Modules into current Script.
'DESCRIPTION
'By working with Modules, this Function is necessary to load external Module Functions into the current VB-Script.
'Call parameter must be an array, because VB-Script functions cannot handle optional Parameters.
'In develepment and Test Enviroment it is possible, to work with distributed Folders with different Modules. Therefor the Parameter
'"GetWinLineDocUniqueIdentifierParams(1)" (which is the ModuleOverrideSourcePath) and the preset Variable "ModuleDefaultSourcePath" are made for.
'After a successful Import of a Module, Function will return True, otherwise a False.
'REQUIREMENT General
'VBS must be enabled
'REQUIREMENT Assembly
'<NONE>
'REQUIREMENT Variables
'FSOModule, Module, ModuleCode
'REQUIREMENT Variables preSet
'<NONE>
'REQUIREMENT Functions
'<NONE>
'VERSION
'Number: 1.0.0.0 / Date: 01.12.2020
'PARAMETER GetWinLineDocUniqueIdentifierParams(0) = WorkingMode
'Give the
'PARAMETER GetWinLineDocUniqueIdentifierParams(1) = DocAccountAndRunningNr
'Optional Parameter.
'PARAMETER GetWinLineDocUniqueIdentifierParams(2) = DocAccountNr
'Optional Parameter.
'PARAMETER GetWinLineDocUniqueIdentifierParams(3) = DocRunningNr
'Optional Parameter.
'EXAMPLE
'Dim GetWinLineDocUniqueIdentifierParams
'Redim GetWinLineDocUniqueIdentifierParams(0)
'GetWinLineDocUniqueIdentifierParams(0) = Module
'LoadVBSModule(GetWinLineDocUniqueIdentifierParams)
'EXAMPLE
'Dim GetWinLineDocUniqueIdentifierParams
'Redim GetWinLineDocUniqueIdentifierParams(1)
'GetWinLineDocUniqueIdentifierParams(0) = Module
'GetWinLineDocUniqueIdentifierParams(1) = "D:\ScriptFiles\Modules"
'LoadVBSModule(GetWinLineDocUniqueIdentifierParams)
On Error Resume Next
If VarType(GetWinLineDocUniqueIdentifierParams) > 8000 Then
WorkingMode = GetWinLineDocUniqueIdentifierParams(0)
DocAccountAndRunningNr = GetWinLineDocUniqueIdentifierParams(1)
DocAccountNr = GetWinLineDocUniqueIdentifierParams(2)
DocRunningNr = GetWinLineDocUniqueIdentifierParams(3)
IF (WorkingMode = "interactive") or (WorkingMode = "interaktive") Then
GetWinLineDocUniqueIdentifier = DocAccountAndRunningNr
Else
GetWinLineDocUniqueIdentifier = DocAccountAndRunningNr
End If
'If no array was used by calling this function
Else
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MSGBOX "The used Parameter is not an Array!" & vbCrlf & _
"",,"DEBUG Info: Parameter is not an Array - GetWinLineDocUniqueIdentifierParams"
End If
GetWinLineDocUniqueIdentifier = ""
End if
End Function 'GetWinLineDocUniqueIdentifier

49
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/GetWinLineInternalProductNumber.vbs Normal file
View File

@@ -0,0 +1,49 @@
' GetWinLineInternalProductNumber(ProductNumber : String, SerialNumber : String)
' ----------------------------------------------------------------------------
' Holt die interne ProductNumber (c002) aus der Artikelview, wenn es eine
' Seriennummer gibt, ansonsten passt der Wert aus dem Parameter
'
' Returns: Interne Artikelnummer
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 10.08.2020 / MK
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
Function GetWinLineInternalProductNumber(ProductNumber, SerialNumber)
Set Conn = CWLStart.CurrentCompany.Connection
Err.Clear
If SerialNumber = "" Then
GetWinLineInternalProductNumber = ProductNumber
Else
SQL = "SELECT [c002] FROM [v021] (NOLOCK) WHERE [c011] = '"& ProductNumber &"' AND [c068] = '"& SerialNumber &"' AND (c038 IS NULL) " & SQLQuery_BasicWhere
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for Internal Article Number.. " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineInternalProductNumber"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetWinLineInternalProductNumber"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - GetWinLineInternalProductNumber"
Exit Function
End If
End If
GetWinLineInternalProductNumber = Result.Value("c002")
End If
End Function

60
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/GetWinLineOriginalLineNumber.vbs Normal file
View File

@@ -0,0 +1,60 @@
' GetWinLineOriginalLineNumber(OrderNumber : String, ArticleNumber : String, IsSerialNumberArticle : Int)
' ----------------------------------------------------------------------------
' Ermittelt die originale Zeilennummer einer belegposition
'
' 18.02.21 - Wird im Packtisch 3.0 nicht mehr verwendet
'
' Returns: GetWinLineOriginalLineNumber : Int
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 18.08.2020 / MK
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
Function GetWinLineOriginalLineNumber(OrderNumber, ArticleNumber, IsSerialNumberArticle)
Set Conn = CWLStart.CurrentCompany.Connection
Err.Clear
If IsSerialNumberArticle = 1 Then
SQL = "SELECT TOP 1 c078 FROM t026 (NOLOCK) "
SQL = SQL & "WHERE c067 = '"& OrderNumber &"' AND c003 = '"& ArticleNumber &"' "
SQL = SQL & SQLQuery_OrderWhere
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for Original Line Number.. " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineOriginalLineNumber"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetWinLineOriginalLineNumber"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - GetWinLineOriginalLineNumber"
Exit Function
End If
End If
GetWinLineOriginalLineNumber = Result.Value("c078")
Else
If DEBUG_ON = True Then
AddDebugLine "Setting Original Line Number to 0.."
ShowDebugBox "GetWinLineOriginalLineNumber"
End If
GetWinLineOriginalLineNumber = "0"
End If
End Function

48
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/GetWinLineProductInfoByProductNumber.vbs Normal file
View File

@@ -0,0 +1,48 @@
' GetWinLineProductInfoByProductNumber(ProductNumber : String, WinLineMandatorNr : String, WinLineYear : Int)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: NAME : TYP
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 23.09.2020 / JJ
' Version Date / Editor: 23.09.2020 / JJ
' Version Number: 1.0.0.0
Function GetWinLineProductInfoByProductNumber(ProductNumber, WinLineMandatorNr, WinLineYear)
On Error Resume Next
If (ProductNumber <> "") Then
SQLTable_WinLineProductInfo = "V021"
SQLQuery_WinLineProductInfo = "c011 = '"& ProductNumber &"' and c002 = c011 and MESOCOMP = '"& WinLineMandatorNr &"' AND MESOYEAR = '"& WinLineCurrentYear &"'"
Set SQLResult_WinLineProductInfo = CWLStart.CurrentCompany.SearchRecord (SQLTable_WinLineProductInfo, SQLQuery_WinLineProductInfo)
If (DEBUG_ON = True) or (DebugMode = "Enabled" ) Then
AddDebugLine "Querying for Article Number.. " & vbNewline
AddDebugLine "Result Columns: " & SQLResult_WinLineProductInfo
AddDebugLine "Result Rows: " & SQLResult_WinLineProductInfo.RowCount
AddDebugLine "SQL: " & SQLQuery_WinLineProductInfo
ShowDebugBox "GetWinLineInternalProductNumber"
End If
If (SQLResult_WinLineProductInfo.RowCount = -1) or (SQLResult_WinLineProductInfo.RowCount = 0) Then
GetWinLineProductInfoByProductNumber = 0
Elseif (SQLResult_WinLineProductInfo.RowCount >= 1) Then
Set GetWinLineProductInfoByProductNumber = SQLResult_WinLineProductInfo
End if
End if
End Function

37
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/GetWinLineStockedAmount.vbs Normal file
View File

@@ -0,0 +1,37 @@
' GetWinLineStockedAmount(ProductNumber : String, IncludeSalesDocuments : Boolean)
' ----------------------------------------------------------------------------
' Lagerstand des Artikels prüfen
'
' Returns: NAME : TYP
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 22.01.2021 / XX
' Version Date / Editor: 22.01.2021 / XX
' Version Number: 1.0.0.0
Function GetWinLineStockedAmount(ProductNumber, IncludeSalesDocuments)
SQL = ""
SQL = SQL & "SELECT "
SQL = SQL & "(SELECT C008 AS [MengeZugang] from [v021] (NOLOCK) where (c002 = '__ARTICLENUMBER__') "& SQLQuery_BasicWhere &") - "
SQL = SQL & "(SELECT C009 AS [MengeAbgang] from [v021] (NOLOCK) where (c002 = '__ARTICLENUMBER__') "& SQLQuery_BasicWhere &") - "
If IncludeSalesDocuments = True Or IncludeSalesDocuments = "True" Or IncludeSalesDocuments = 1 Then
' Include Products from sales documents
SQL = SQL & "ISNULL((SELECT SUM(C035) AS [MengeVerkauf] FROM [t014] (NOLOCK) where c000 = '__ARTICLENUMBER__' "& SQLQuery_BasicWhere &"), 0) "
Else
' Skip Products from sales documents
SQL = SQL & "(SELECT 0) "
End If
SQL = SQL & "AS c000"
SQL = Replace(SQL, "__ARTICLENUMBER__", ProductNumber)
Set Result = CWLStart.CurrentCompany.Connection.Select(SQL)
GetWinLineStockedAmount = Result.Value("c000")
End Function

75
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/GetWinLineStorageLocation.vbs Normal file
View File

@@ -0,0 +1,75 @@
' GetWinLineStorageLocation(ProductNumber : String, ProductSerialNumber : String, IsSerialNumberArticle : Int)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: GetWinLineStorageLocation : Int
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 07.01.2021 / XX
' Version Date / Editor: 07.01.2021 / XX
' Version Number: 1.0.0.0
Function GetWinLineStorageLocation(ProductNumber, ProductSerialNumber, IsSerialNumberArticle)
Set Conn = CWLStart.CurrentCompany.Connection
' Get 'Lagerortstruktur' for Product
SQL = "SELECT c178 FROM [V021] (NOLOCK) WHERE c010 = '"& ProductNumber &"'"
Set Result = Conn.Select(SQL)
If Result.Value("c178") = 0 Then
GetWinLineStorageLocation = 0
Exit Function
End If
If IsSerialNumberArticle = 1 Then
Identifier = GetWinLineInternalProductNumber(ProductNumber, ProductSerialNumber)
Else
Identifier = ProductNumber
End If
SQL = ""
SQL = SQL & "SELECT TOP 1 T335.c000 "
SQL = SQL & "FROM [T024] (NOLOCK), [T335] (NOLOCK), [T299] (NOLOCK) "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C001 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L1 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C002 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L2 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C003 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L3 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C004 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L4 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C005 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L5 "
SQL = SQL & "WHERE T299.C000 = '"& Identifier &"' AND T299.C000 = T024.C002 AND T299.MESOCOMP = '" & MandatorNr & "' AND (T299.MESOYEAR = " & WinLineCurrentYear & " OR T299.MESOYEAR = " & WinLineCurrentYear - 12 & ") AND T024.MESOCOMP = '" & MandatorNr & "' "
SQL = SQL & "AND (T024.MESOYEAR = " & WinLineCurrentYear & " OR T024.MESOYEAR = " & WinLineCurrentYear - 12 & ")AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ") AND (T299.C001 = T335.C020 AND T299.C002 = T335.C021 "
SQL = SQL & "AND T299.C003 = T335.C022 AND T299.C004 = T335.C023 AND T299.C005 = T335.C024 AND T299.C006 = T335.C025) "
SQL = SQL & "ORDER BY T335.c000 DESC, T299.C001,T299.C002,T299.C003,T299.C004,T299.C005,T299.C006"
If DEBUG_ON = True Then
AddDebugLine "SQL Part 1: " & Mid(SQL, 1, 750)
ShowDebugBox "GetWinLineStorageLocation"
AddDebugLine "SQL Part 2: " & Mid(SQL, 750)
ShowDebugBox "GetWinLineStorageLocation"
End If
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying storage location... " & vbNewline
AddDebugLine "ArticleNumber: " & ProductNumber
AddDebugLine "SerialNumber: " & ProductSerialNumber
AddDebugLine "IsSerialNumber Article: " & IsSerialNumberArticle
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineStorageLocation"
End If
If Result = -1 Then
GetWinLineStorageLocation = 0
Else
GetWinLineStorageLocation = Result.Value("c000")
End If
End Function

74
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/GetWinLineUserData.vbm Normal file
View File

@@ -0,0 +1,74 @@
' GetWinLineUserData(UserID: Int)
' ----------------------------------------------------------------------------
' Holt anhand der UserID Loginname, Namen und Durchwahl
' aus der Systemtabelle CWLSYSTEM.T002SRV
'
' Aus den Daten wird ein String aufgebaut, der dann in Meldungen
' verwendet werden kann.
'
' Returns: GetWinLineUserData : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 26.04.2021 / MP
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
Function GetWinLineUserData(UserID)
Err.Clear
GetWinLineUserData = ""
If Len(UserID) <= 0 Then
If DEBUG_ON = True Then
Msgbox "Parameter UserID ist leer!", vbExclamation, DEFAULT_TITLE & " - GetWinLineUserData"
End If
Exit Function
End If
Set Conn = CWLCompany.GetSystemConnection(cwlSystemServerSRV)
SQL = "SELECT TOP 1 c001, c026, c028 FROM T002SRV (NOLOCK) "
SQL = SQL & "WHERE c000 = " & UserID
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for Original Line Number.. " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineUserData"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetWinLineUserData"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - GetWinLineUserData"
Exit Function
End If
End If
ResultString = ""
If Len(Result.Value("c026")) > 0 Then
' Name des Benutzers
ResultString = Result.Value("c026")
Else
' Loginname des Benutzers, muss immer belegt sein.
ResultString = Result.Value("c001")
End If
If Len(Result.Value("c026")) > 0 Then
' Durchwahl ergänzen, wenn vorhanden
ResultString = ResultString & " (" & Result.Value("c028") & ")"
End If
GetWinLineUserData = ResultString
End Function

29
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/GetWindowsEnvironment.vbm Normal file
View File

@@ -0,0 +1,29 @@
' GetWindowsEnvironment(EnvName: String)
' ----------------------------------------------------------------------------
' URL: https://skriptwiki.ffsf.de/doku.php/umgebungsvariablen
'
' Mögliche Werte für EnvName sind hier zu finden:
' http://www.winfaq.de/faq_html/Content/tip0000/onlinefaq.php?h=tip0328.htm
'
' Returns: GetWindowsEnvironment : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 23.03.2021 / MP
' Version Date / Editor: 23.03.2021 / MP
' Version Number: 3.0.0.0
Function GetWindowsEnvironment(EnvName)
If (Len(EnvName) <= 0) Then
GetWindowsEnvironment = ""
Exit Function
End If
Set WshShell = CreateObject("WScript.Shell")
Set oEnv = WshShell.Environment("Process")
GetWindowsEnvironment = oEnv(EnvName)
Set oEnv = Nothing
End Function

234
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/ArticleExists.vbm Normal file
View File

@@ -0,0 +1,234 @@
' ArticleExists(Identifier: String)
' ----------------------------------------------------------------------------
' Findet Artikelnummer anhand von versch. Kriterien
' - Artikel-Nummer, Alternative Artikel-Nummer, EAN-Code, Seriennummer
' - Gibt die Zeile im Grid zurück in der Artikel das erste Mal gefunden wurde
'
' Returns: ArticleExists: Int
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.09.2020 / JJ
' Version Date / Editor: 06.04.2021 / MP
' Version Number: 3.0.0.2
Const ARTICLE_EXISTS_NO_STOCK = -99
Const ARTICLE_EXISTS_NO_SERIALNUMBER = -98
Const ARTICLE_EXISTS_NO_ARTICLE_EAN = -97
Const ARTICLE_EXISTS_NO_REGEX_MATCH = -96
Const ARTICLE_EXISTS_OVERSCANNED = -95
Function ArticleExists(Identifier)
ArticleExists = 0
HasError = False
CURRENT_SERIALNUMBER = ""
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' ===================== ARTIKEL NUMMER / EAN-CODE =====================
SQL = ""
' Artikelnummer / EAN-Code / Alternative Artikelnummer
SQL = SQL & "((C002 = '" & Identifier & "') Or (C075 = '" & Identifier & "') Or (C114 = '" & Identifier & "')) AND "
' Artikel darf nicht inaktiv sein
SQL = SQL & "(c038 IS NULL) "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultArtikel = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for Article by ArticleNo/EAN-Code.. " & vbNewline & vbNewline
AddDebugLine "Result Columns: " & ResultArtikel & vbNewline
AddDebugLine "Result Rows: " & ResultArtikel.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
' ===================== SERIENNUMMER =====================
SQL = ""
' Artikelnummer
SQL = SQL & "(C068 = '" & Identifier & "') AND "
' Artikel darf nicht inaktiv sein
SQL = SQL & "(c038 IS NULL) "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultSeriennummer = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for Article by Article serial number " & vbNewline
AddDebugLine "Result Columns: " & ResultSeriennummer
AddDebugLine "Result Rows: " & ResultSeriennummer.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
If ResultSeriennummer.RowCount > 0 Then
SerialNumberString = ResultSeriennummer.Value("C068")
MainArticleNumber = ResultSeriennummer.Value("C011")
SQL = ""
SQL = SQL & "(C002 = '" & MainArticleNumber & "') "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultMainArticle = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If ResultMainArticle.RowCount > 0 Then
SerialNumberPattern = ResultMainArticle.Value("C222")
End If
If DEBUG_ON = True Then
AddDebugLine "Preparing Regex Check. " & vbNewline
AddDebugLine "SerialNumberString: " & SerialNumberString
AddDebugLine "SerialNumberPattern: " & SerialNumberPattern
AddDebugLine "MainArticleNumber: " & MainArticleNumber
ShowDebugBox "ArticleExists"
End If
If Len(SerialNumberPattern) > 0 And Len(SerialNumberString) > 0 Then
Set SerialNumberRegex = New Regexp
With SerialNumberRegex
.Pattern = SerialNumberPattern
.IgnoreCase = False
.Global = False
End With
Set RegexMatch = SerialNumberRegex.Execute(SerialNumberString)
Set FirstMatch = RegexMatch.Item(0)
If DEBUG_ON = True Then
AddDebugLine "Checked Serialnumber against Regex. (1/2)" & vbNewline
AddDebugLine "FirstMatch.Length: " & FirstMatch.Length
AddDebugLine "Len(SerialNumberString): " & Len(SerialNumberString)
AddDebugLine "FirstMatch.FirstIndex: " & FirstMatch.FirstIndex
ShowDebugBox "ArticleExists"
End If
If Not (FirstMatch.Length = Len(SerialNumberString) And FirstMatch.FirstIndex = 0) Then
ArticleExists = ARTICLE_EXISTS_NO_REGEX_MATCH
HasError = True
End If
If DEBUG_ON = True Then
AddDebugLine "Checked Serialnumber against Regex. (2/2)" & vbNewline
AddDebugLine "Result: " & SerialNumberRegex.Test(SerialNumberString)
AddDebugLine "Serialnumber: " & SerialNumberString
AddDebugLine "Regex: " & SerialNumberPattern
ShowDebugBox "ArticleExists"
End If
End If
CURRENT_SERIALNUMBER = Identifier
Set Result = ResultSeriennummer
Else
Set Result = ResultArtikel
End If
'==========================================================
If HasError = True Then
' Just skip the rest of the function and return the current error
Elseif Result.RowCount > 0 Then
' Wir brauchen die Hauptartikelnummer, weil die Prüfung sonst bei SN-Artikeln fehlschlägt
MainArticleNumber = Result.Value("C011")
RealArticleNumber = Result.Value("C002")
ProductShape = 0
' Ausprägung des Artikels prüfen
SQL = ""
SQL = "SELECT c001 FROM t301 (NOLOCK) WHERE c003 = (SELECT c066 FROM v021 (NOLOCK) WHERE c002 = '" & RealArticleNumber & "' " & SQLQuery_BasicWhere & ")" & SQLQuery_BasicWhere
If DEBUG_ON = True Then
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
Set Result = CWLStart.CurrentCompany.Connection.Select(SQL)
If Result > -1 Then
ProductShape = Result.Value("c001")
Else
ProductShape = 0
End If
CURRENT_SHAPE = ProductShape
AmountStocked = GetWinLineStockedAmount(RealArticleNumber, False)
If DEBUG_ON = True Then
AddDebugLine "Checking stock of product: " & RealArticleNumber & " (" & MainArticleNumber & ")" & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "Stock: " & AmountStocked
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
If AmountStocked > 0 Then
If DEBUG_ON = True Then
AddDebugLine "Amount stocked: " & AmountStocked
End If
' Vorkommen in Tabelle prüfen
For GridLineIndex = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(GridLineIndex, COLUMN_ARTICLENUMBER)
Total = Cint(Grid.GetCellValue(GridLineIndex, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(GridLineIndex, COLUMN_SCANNED))
Amount = CInt(amountBox.ScreenContents)
If CurrentArticleNumber = MainArticleNumber Then
If DEBUG_ON = True Then
AddDebugLine "CurrentArticleNumber matches MainArticleNumber! (" & CurrentArticleNumber & ")"
End If
If Total > Scanned Then
If DEBUG_ON = True Then
AddDebugLine "Product is not yet scanned completely and exists in Row " & GridLineIndex & "!"
End If
If (Total - Scanned) >= Amount Then
ArticleExists = GridLineIndex
Exit For
Else
If GetCountInDuplList(CurrentArticleNumber) <= 1 Then
Exit For
End If
End If
Else
ArticleExists = ARTICLE_EXISTS_OVERSCANNED
End If
End If
Next
Else
If DEBUG_ON = True Then
AddDebugLine "Amount stocked: 0"
End If
ArticleExists = ARTICLE_EXISTS_NO_STOCK
End If
If DEBUG_ON = True Then
ShowDebugBox "ArticleExists"
End If
Else
If CURRENT_SERIALNUMBER = "" Then
ArticleExists = ARTICLE_EXISTS_NO_ARTICLE_EAN
Else
ArticleExists = ARTICLE_EXISTS_NO_SERIALNUMBER
End If
End If
End Function

65
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/CheckMacroArticlesComplete.vbm Normal file
View File

@@ -0,0 +1,65 @@
' CheckMacroArticlesComplete()
' ----------------------------------------------------------------------------
' Prüft, ob die im Auftrag enthaltenen Macro-Artikel
' vollständig sind, und vermerkt die Infos im
' MACRO_ARTICLE_LIST-Array
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 08.03.2021 / MP
' Version Date / Editor: 08.03.2021 / MP
' Version Number: 3.0.0.0
Sub CheckMacroArticlesComplete()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount: Do
MacroFlag = Cint(Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG))
If MacroFlag = 1 Then
LineNumber = Cint(Grid.GetCellValue(GridIndex, COLUMN_LINE_NUMBER))
MacroArticleListIndex = -1
For MacroArrayIndex = 0 To UBound(MACRO_ARTICLE_LIST)
If MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = LineNumber Then
MacroArticleListIndex = MacroArrayIndex
Exit For
End If
Next
For InnerGridIndex = GridIndex + 1 To Grid.LineCount: Do
InnerMacroFlag = Cint(Grid.GetCellValue(InnerGridIndex, COLUMN_MACRO_FLAG))
If InnerMacroFlag = 2 Then
AmountTotal = Cint(Grid.GetCellValue(InnerGridIndex, COLUMN_TOTAL))
AmountScanned = Cint(Grid.GetCellValue(InnerGridIndex, COLUMN_SCANNED))
If AmountTotal <> AmountScanned Then
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_GRID_LINE_INDEX, MacroArticleListIndex) = GridIndex
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArticleListIndex) = False
' An der Stelle des unvollständigen Artikels weiter prüfen
GridIndex = InnerGridIndex
' Aus Makroartikel aussteigen, weil unvollständig
Exit For
End If
Else
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_GRID_LINE_INDEX, MacroArticleListIndex) = GridIndex
' An der Stelle des unvollständigen Artikels weiter prüfen
GridIndex = InnerGridIndex
' Aus Makroartikel aussteigen, weil vollständig
Exit For
End If
Loop While False: Next
Else
' Nächsten Artikel bearbeiten
Exit Do
End If
Loop While False: Next
End Sub

51
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/CheckOrderIsLocked.vbm Normal file
View File

@@ -0,0 +1,51 @@
' CheckOrderIsLocked(OrderNumber : String)
' ----------------------------------------------------------------------------
' Prüft, ob der Auftrag gesperrt ist.
' Wenn der Auftrag gesperrt ist, wird der Anwender informiert,
' wer die Sperre hält, und ob man es erneut versuchen möchte,
' oder Abbrechen will. Das Verhalten orientiert sich an der
' Vorlage, wie die Winline auf solche Sperrren reagiert.
'
' Returns: CheckOrderIsLocked : Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 07.04.2021 / MP
' Version Date / Editor: 07.04.2021 / MP
' Version Number: 3.0.0.2
Function CheckOrderIsLocked(OrderNumber)
CheckOrderIsLocked = False
If Len(OrderNumber) <= 0 Then
' Ohne Auftrag geht gar nichts
Exit Function
End If
Dim ContinueFlag : ContinueFlag = True
Do
UserId = IsOrderLocked(OrderNumber)
If UserId > 0 Then
CheckOrderIsLocked = True ' Rückgabewert
QuestionText = "Der Auftrag [" & OrderNumber & "] wird von Benutzr [" & GetWinLineUserData(UserID) & "] bearbeitet! " & vbNewLine & vbNewLine
Answer = MsgBox(QuestionText & "Wollen Sie abbrechen?", vbYesno + vbQuestion, DEFAULT_TITLE & " - CheckOrderIsLocked")
If Answer = vbYes Then
ContinueFlag = False ' Abbrechen
Else
ContinueFlag = True ' Weiter prüfen
End If
Else
CheckOrderIsLocked = False ' Rückgabewert
ContinueFlag = False
End If
Loop While ContinueFlag = true
End Function

282
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/CompleteOrder.vbm Normal file
View File

@@ -0,0 +1,282 @@
' CompleteOrder()
' ----------------------------------------------------------------------------
' Schließt die Prüfung ab und erstellt einen Lieferschein
'
' Returns: CompleteOrder : Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.09.2021 / JJ
' Version Date / Editor: 04.05.2021 / MP
' Version Number: 3.0.0.3
Function CompleteOrder()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Conn = CWLStart.CurrentCompany.Connection
Set Grid = mywin.Controls.Item(GRID_ID).Grid
If MACRO_ARTICLE_COUNTER > 0 Then
Dim MacroArticleReseted : MacroArticleReseted = False
CheckMacroArticlesComplete()
For MacroArrayIndex = 0 To Ubound(MACRO_ARTICLE_LIST, 2)
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArrayIndex) = False) AND _
(MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_SCAN_FLAG, MacroArrayIndex) = True) Then
questionText = "Der Package-Artikel [" & MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_NUMBER, MacroArrayIndex) & "] ist unvollständig!" & vbNewLine & vbNewLine
Answer = MsgBox(questionText & "Soll das gesamte Package zurückgesetzt werden?", vbYesno + vbQuestion, DEFAULT_TITLE)
If Answer = vbYes Then
ResetValuesByMacroLineNumber MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex)
MacroArticleReseted = True
Else
CompletedPackages = Cint(InputBox("Wieviele Package-Artikel von insgesamt [" & MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_REMAINING, MacroArrayIndex) & "] werden damit ausgeliefert?", "Anzahl fertige Packages", "0"))
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex) = CompletedPackages
End If
End If
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArrayIndex) = True) Then
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex) = MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_REMAINING, MacroArrayIndex)
End If
Next
If MacroArticleReseted = True Then
Answer = MsgBox("Einer oder mehrere Package-Artikel wurden zurückgesetzt. Soll die Lieferscheinerstellung abgebrochen werden?", vbYesno + vbQuestion, DEFAULT_TITLE)
If Answer = vbYes Then
CompleteOrder = False
Exit Function
End If
End If
' Übertrage Macro-Daten zurück ins Grid
TransferMacroData()
End If
' Übertrage die Grid-Daten zurück in die Order-Datenstruktur
TransferGridData()
' Eine letzte Möglichkeit die Auftragsdaten zu tunen
UpdateOrderDataBeforeDelNote()
Dim OrderId, AccountSQL, MandatorId, RunningNumber
If DEBUG_ON = True Then
AddDebugLine "Completing order.. " & vbNewline
ShowDebugBox "CompleteOrder"
End If
OrderId = mywin.Controls.Item(ORDER_INPUT).ScreenContents
AccountSQL = "SELECT DISTINCT c021 FROM t025 (NOLOCK) WHERE c044 = '" & OrderId & "' " & SQLQuery_OrderWhere
Set AccountResult = Connection.Select(AccountSQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for CustomerAccountId.. " & vbNewline
AddDebugLine "Result Columns: " & AccountResult
AddDebugLine "Result Rows: " & AccountResult.RowCount
AddDebugLine "SQL: " & AccountSQL
ShowDebugBox "CompleteOrder"
End If
MandatorId = AccountResult.Value("c021")
RunningNumber = RUNNING_NUMBER_PREFIX & OrderId
BelegKey = Cstr(DateDiff("s", "01/01/1970 00:00:00", Now))
' ===================== KOPFDATEN =====================
Dim Request, URL, XML
Dim NowObject : NowObject = Now
Dim DateString : DateString = Year(NowObject) & "-" & GetLeftPad(Month(NowObject)) & "-" & GetLeftPad(Day(NowObject))
Dim TimeString : TimeString = GetLeftPad(Hour(NowObject)) & ":" & GetLeftPad(Minute(NowObject)) & ":" & GetLeftPad(Second(NowObject))
Dim UserNumber : UserNumber = Cwlstart.Currentuser.Number
Dim ComputerName : ComputerName = GetWindowsEnvironment("COMPUTERNAME")
' === WEB SERVICES =======================
XML = ""
XML = XML & "<?xml version=""1.0"" encoding=""UTF-8""?>"
XML = XML & "<MESOWebService TemplateType=""__TYPE__"" Template=""__VORLAGE__"" option=""__OPTION__"" printVoucher=""__PRINT__"">"
XML = XML & "<__VORLAGE__T025>"
XML = XML & "<BELEGKEY>" & BelegKey & "</BELEGKEY>"
XML = XML & "<Kontonummer>" & MandatorId & "</Kontonummer>"
XML = XML & "<Laufnummer>" & RunningNumber & "</Laufnummer>"
XML = XML & "<Auftragsnummer>" & OrderId & "</Auftragsnummer>"
XML = XML & "<Datum_Lieferschein>" & DateString & "</Datum_Lieferschein>"
XML = XML & "<BenutzerNummerPacktisch>" & UserNumber & "</BenutzerNummerPacktisch>"
XML = XML & "<ErstellDatumPacktisch>" & DateString & " " & TimeString & "</ErstellDatumPacktisch>"
XML = XML & "<ComputerNamePacktisch>" & ComputerName & "</ComputerNamePacktisch>"
XML = XML & "<VersionPacktisch>" & PACKTISCH_VERSION & "</VersionPacktisch>"
XML = XML & "</__VORLAGE__T025>"
' === EXIM TABELLE =======================
HeadSQL = "INSERT INTO " & SQLDB_for_EXIM & "." & SQLHeadTB_for_EXIM & " "
HeadSQL = HeadSQL & "(BELEGKEY, Kontonummer, Laufnummer, Auftragsnummer, Belegdatum) "
HeadSQL = HeadSQL & "VALUES("& BelegKey &", '"& MandatorId &"', '"& RunningNumber &"', '"& OrderId &"', GETDATE())"
HeadResult = Conn.ExecuteSQL(HeadSQL)
If DEBUG_ON = True Then
AddDebugLine "Inserting Head Data" & vbNewline
AddDebugLine "Result: " & HeadResult
AddDebugLine "SQL: " & HeadSQL
ShowDebugBox "CompleteOrder"
End If
' ===================== ENDE KOPFDATEN =====================
' ============================ MITTEDATEN ============================
Dim ArticleNumber, AmountScanned, SerialNumber, StorageLocation, LineNumber
For OrderArrayIndex = 0 To Ubound(ORDER_ARTICLE_DATA, 2): Do
IsSerialNumberArticle = Cint(ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex))
ArticleNumber = ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex)
SerialNumber = ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex)
AmountScanned = CInt(ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex))
LineNumber = CInt(ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex))
DataType = CInt(ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex))
VKPreisEinzel = Replace(ORDER_ARTICLE_DATA(INDEX_PRICE_VK_EINZEL, OrderArrayIndex), ",", ".")
If DEBUG_ON = True Then
AddDebugLine "Processing Article: " & ArticleNumber
AddDebugLine "SerialNumber: " & SerialNumber
AddDebugLine "LineNumber: " & LineNumber
AddDebugLine "DataType: " & DataType
ShowDebugBox "CompleteOrder"
End If
' Text-Artikel werden nicht übergeben
If DataType = 3 Then
Exit Do
End If
If PRINT_DOCUMENT_AFTER_COMPLETION = True Then
StorageLocation = GetWinLineStorageLocation(ArticleNumber, SerialNumber, IsSerialNumberArticle)
InternalArticleNumber = GetWinLineInternalProductNumber(ArticleNumber, SerialNumber)
Else
StorageLocation = 0
InternalArticleNumber = 0
End If
' === EXIM TABELLE =======================
MidSQL = "INSERT INTO " & SQLDB_for_EXIM & "." & SQLMiddleTB_for_EXIM & " "
MidSQL = MidSQL & "(BELEGKEY, Artikelnummer, Hauptartikelnummer, Zeilennummer, Datentyp, Mengegeliefert, ChargeIdentnummer, Lagerort, Einzelpreis) "
MidSQL = MidSQL & "VALUES (" & BelegKey & ", '" & ArticleNumber & "', '" & ArticleNumber & "', "
If IsSerialNumberArticle = 1 Then
MidSQL = MidSQL & LineNumber
Else
MidSQL = MidSQL & " NULL"
End If
MidSQL = MidSQL & ", '1', " & AmountScanned & ", '" & SerialNumber & "', " & StorageLocation& ", " & VKPreisEinzel & ")"
MidResult = Conn.ExecuteSQL(MidSQL)
' === WEB SERVICES =======================
MidXML = ""
MidXML = MidXML & "<__VORLAGE__T026>"
MidXML = MidXML & "<BELEGKEY>" & BelegKey & "</BELEGKEY>"
MidXML = MidXML & "<Artikelnummer>" & InternalArticleNumber & "</Artikelnummer>"
MidXML = MidXML & "<Hauptartikelnummer>" & ArticleNumber & "</Hauptartikelnummer>"
MidXML = MidXML & "<Zeilennummer>" & LineNumber & "</Zeilennummer>"
MidXML = MidXML & "<Datentyp>" & "1" & "</Datentyp>"
MidXML = MidXML & "<Mengegeliefert>" & AmountScanned & "</Mengegeliefert>"
MidXML = MidXML & "<ChargeIdentnummer>" & SerialNumber & "</ChargeIdentnummer>"
MidXML = MidXML & "<Lagerort>" & StorageLocation & "</Lagerort>"
MidXML = MidXML & "<Einzelpreis>" & VKPreisEinzel & "</Einzelpreis>"
MidXML = MidXML & "</__VORLAGE__T026>"
If DEBUG_ON = True Then
AddDebugLine "Inserting Middle Data" & vbNewline
AddDebugLine "For Article " & ArticleNumber
AddDebugLine "And Amount " & AmountScanned
AddDebugLine "Result: " & MidResult & vbNewline
AddDebugLine "SQL: " & MidSQL & vbNewline
AddDebugLine "XML: " & MidXML
ShowDebugBox "CompleteOrder"
End If
XML = XML & MidXML
Loop While False: Next
XML = XML & "</MESOWebService>"
XML = Replace(XML, "__VORLAGE__", WEB_VORLAGE)
XML = Replace(XML, "__TYPE__", WEB_TYPE)
XML = Replace(XML, "__PRINT__", WEB_PRINT)
XML = Replace(XML, "__OPTION__", WEB_OPTION)
URL = "http://__SERVER__/ewlservice/import?User=__USER__&Password=__PASSWORD__&Company=__COMPANY__&Type=30&Vorlage=__VORLAGE__&Actioncode=__ACTIONCODE__&byref=0&Data=__DATA__"
URL = Replace(URL, "__SERVER__", WEB_SERVER)
URL = Replace(URL, "__USER__", WEB_USER)
URL = Replace(URL, "__PASSWORD__", WEB_PASS)
URL = Replace(URL, "__COMPANY__", WEB_COMPANY)
URL = Replace(URL, "__VORLAGE__", WEB_VORLAGE)
URL = Replace(URL, "__ACTIONCODE__", WEB_ACTIONCODE)
URL = Replace(URL, "__DATA__", XML)
If DEBUG_ON = True Then
AddDebugLine "Sending Request to WebServices.."
AddDebugLine "URL: " & URL
AddDebugLine "WEB_PRINT: " & WEB_PRINT
AddDebugLine "WEB_OPTION: " & WEB_OPTION
ShowDebugBox "CompleteOrder"
End If
' ======================= ENDE MITTEDATEN =======================
If PRINT_DOCUMENT_AFTER_COMPLETION = True Then
' ===================== HTTP REQUEST =====================
Set Request = CreateObject("MSXML2.XMLHTTP")
Request.Open "POST", URL, False
Request.Send
Response = Request.ResponseText
Status = Request.Status
If DEBUG_ON = True Then
AddDebugLine "Response from WebServices!"
AddDebugLine "Status: " & Status
AddDebugLine "Body: " & Response
ShowDebugBox "CompleteOrder"
End If
' =================== ENDE HTTP REQUEST ==================
Error = False
Message = ""
If Status = 200 Then
If TestIsWebserviceResponseSuccessful(Response) = True Then
Message = "Lieferschein wurde übertragen!"
Else
Error = True
Message = "Lieferschein wurde nicht übertragen! Fehlerdetails: " & vbNewline & vbNewline & Response
End If
Else
Error = True
Message = "Fehler beim Zugriff auf Webservices aufgetreten!" & vbNewline & vbNewline & "Status: " & Status
End If
If Error = False Then
MsgBox Message, vbInformation, DEFAULT_TITLE
CompleteOrder = True
Else
MsgBox Message, vbExclamation, DEFAULT_TITLE & " - Fehler bei Abschluss"
CompleteOrder = False
End If
Else
CompleteOrder = True
End If
End Function

35
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/CountRowsForArticle.vbm Normal file
View File

@@ -0,0 +1,35 @@
' CountRowsForArticle(ArticleNumber : String)
' ----------------------------------------------------------------------------
' Gibt die Anzahl der Zeilen zu einer Artikelnummer zurück
'
' Returns: CountRowsForArticle : Int
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 25.09.2020 / JJ
' Version Date / Editor: 25.09.2020 / JJ
' Version Number: 1.0.0.0
Function CountRowsForArticle(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim Count : Count = 0
If DEBUG_ON = True Then
AddDebugLine "Counting rows for Article: " & ArticleNumber
ShowDebugBox "CountRowsForArticle"
End If
For GridIndex = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(GridIndex, COLUMN_ARTICLENUMBER)
If ArticleNumber = CurrentArticleNumber Then
Count = Count + 1
End If
Next
CountRowsForArticle = Count
End Function

392
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/DuplicateArticles.vbm Normal file
View File

@@ -0,0 +1,392 @@
' DuplicateArticles (ArticleNumber : String, MacroFlag : Int, ChargeFlag : Int)
' ----------------------------------------------------------------------------
' Funktionen zur Behandlung mehrfach vorkommender
' Artikelnummern. Daten werden im Array DUPL_ARTICLE_LIST
' gespeichert und verwaltet.
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 15.04.2021 / MP
' Version Date / Editor: 15.04.2021 / MP
' Version Number: 3.0.0.2
Const ARTICLE_IS_NOT_IN_DUPLICATES_LIST = -199
Const GRIDLINE_INDEX_IS_NOT_CHOOSEABLE = -198
Const NO_GRIDLINE_INDEX_CHOSEN = -197
CONST USE_ORIGINAL_ROW = -196
' Legt für jeden scannbaren Artikel einen Satz in der Duplikate-Struktur an
' und zählt wie oft dieser Artikel vorkommt.
' Für Artikel innerhalb eines Macros wird zusätzlich ein eigener Zähler hochgesetzt.
Sub AddArticleNumberToDuplList(ArticleNumber, MacroFlag, ChargeFlag)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex = ARTICLE_IS_NOT_IN_DUPLICATES_LIST Then
' Lege neue Zeile an
AddTwoDimArrayRow DUPL_ARTICLE_LIST
DuplArrayIndex = UBound(DUPL_ARTICLE_LIST, 2)
DUPL_ARTICLE_LIST(COLUMN_DUPL_ARTICLE_NUMBER, DuplArrayIndex) = ArticleNumber
DUPL_ARTICLE_LIST(COLUMN_DUPL_CHARGE_FLAG, DuplArrayIndex) = ChargeFlag
DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex) = 1
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) = 0
If (MacroFlag = 2) Then
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) = 1
End If
DUPL_ARTICLE_LIST(COLUMN_DUPL_GRID_LINE_INDEXE, DuplArrayIndex) = ""
Else
' Erhöhe Wert in bestehender Zeile
currentValue = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex) = currentValue + 1
If (MacroFlag = 2) Then
currentMacroValue = DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex)
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) = currentMacroValue + 1
End If
End If
End Sub
' Reduziert die Zähler für den Artikel, wenn eine Zeile vollständig gescannt wurde.
' Für Macro-Unterteile wird zusätzlich der MacroCounter reduziert
Sub ReduceCounterInDuplList(ArticleNumber, MacroFlag)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex >= 0 Then
' Vermindert Wert für den Artikel
currentValue = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex) = currentValue - 1
If (MacroFlag = 2) Then
currentMacroValue = DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex)
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) = currentMacroValue - 1
End If
End If
End Sub
' Reduziert die Zähler im Sub-Macro-Artikel-Token, wenn eine Zeile vollständig gescannt wurde.
' benötigt die ZeilenNummer des Macro Artikels
Sub ReduceSubMacroCounterInDuplList(ArticleNumber, MacroLineNumber)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex >= 0 Then
TestToken = "#" & MacroLineNumber & ","
CurrentMacroLineNumbers = DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex)
If Len(CurrentMacroLineNumbers) > 0 And InStr(CurrentMacroLineNumbers, TestToken) > 0 Then
'Counter reduzieren!
TempMacroLineNumbers = ""
SplittedTokens = Split(CurrentMacroLineNumbers)
For Each Token In SplittedTokens
If (InStr(Token, TestToken) > 0) Then
'Treffer, Counter auslesen, erhöhen und zurückschreiben
TempToken = Split(Token, ",")
TokenLen = Len(TempToken(1))-1
NewCount = CInt(Left(TempToken(1), TokenLen)) - 1
If NewCount > 0 Then
TempMacroLineNumbers = TempMacroLineNumbers & " " & TestToken & NewCount & "#"
End If
Else
' Kein Treffer, Token wieder zurückschreiben
TempMacroLineNumbers = TempMacroLineNumbers & " " & Token
End If
Next
CurrentMacroLineNumbers = TempMacroLineNumbers
End If
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex) = CurrentMacroLineNumbers
End If
End Sub
' Ergänzt die GridLine-Indexe für Artikel, die mehrfach vorkommen
' Bedingung: Der Artikel muss bereits in der Duplicate-Struktur
' enthalten sein, und einen Counter > 1 haben.
Sub AddGridLineIndexToDuplicateArticles(ArticleNumber, GridLineIndex)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex >= 0 Then
DuplCount = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
If DuplCount > 1 Then
CurrentGridLineIndexe = DUPL_ARTICLE_LIST(COLUMN_DUPL_GRID_LINE_INDEXE, DuplArrayIndex)
If Len(CurrentGridLineIndexe) > 0 Then
CurrentGridLineIndexe = CurrentGridLineIndexe & " " & FormatNumber(GridLineIndex, 0)
Else
CurrentGridLineIndexe = FormatNumber(GridLineIndex, 0)
End If
DUPL_ARTICLE_LIST(COLUMN_DUPL_GRID_LINE_INDEXE, DuplArrayIndex) = CurrentGridLineIndexe
End If
End If
End Sub
' Ergänzt die LineNumber der Macro-Hauptartikel für Macro-Sub-Artikel
' Gesammelt werden Tokens in der Form #LN,1#, wenn sie noch nicht vorkommen.
' Der Counter wird hochgezählt, um das Vorkommen des Artikels in verschiedenen Macros abzufangen
' Bedingung: Der Artikel muss bereits in der Duplicate-Struktur
' enthalten sein, und einen Counter > 1 haben.
Sub AddMacroLineNumberTokensToDuplicateArticles(ArticleNumber, MacroLineNumber)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex >= 0 Then
DuplCount = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
If DuplCount > 1 Then
TestToken = "#" & MacroLineNumber & ","
CurrentMacroLineNumbers = DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex)
If Len(CurrentMacroLineNumbers) <= 0 Then
CurrentMacroLineNumbers = TestToken & "1#"
ElseIf InStr(CurrentMacroLineNumbers, TestToken) = 0 Then
CurrentMacroLineNumbers = CurrentMacroLineNumbers & " " & TestToken & "1#"
Else
'Counter erhöhen!
TempMacroLineNumbers = ""
SplittedTokens = Split(CurrentMacroLineNumbers)
For Each Token In SplittedTokens
If (InStr(Token, TestToken) > 0) Then
'Treffer, Counter auslesen, erhöhen und zurückschreiben
TempToken = Split(Token, ",")
TokenLen = Len(TempToken(1))-1
NewCount = CInt(Left(TempToken(1), TokenLen)) + 1
TempMacroLineNumbers = TempMacroLineNumbers & " " & TestToken & NewCount & "#"
Else
' Kein Treffer, Token wieder zurückschreiben
TempMacroLineNumbers = TempMacroLineNumbers & " " & Token
End If
Next
CurrentMacroLineNumbers = TempMacroLineNumbers
End If
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex) = CurrentMacroLineNumbers
End If
End If
End Sub
' Prüfe, ob eine Artikelnummer bereits in dem Array enthalten ist
' oder nicht
' Rueckgabewert: Index des Artikels im Array, wenn bereits vorhande, sonst -1 falls nicht vorhanden
Function ExistArticleInDuplList(ArticleNumber)
ExistArticleInDuplList = ARTICLE_IS_NOT_IN_DUPLICATES_LIST
If (UBound(DUPL_ARTICLE_LIST, 2) > -1) Then
For DuplArrayIndex = 0 To UBound(DUPL_ARTICLE_LIST, 2)
If (DUPL_ARTICLE_LIST(COLUMN_DUPL_ARTICLE_NUMBER, DuplArrayIndex) = ArticleNumber) Then
ExistArticleInDuplList = DuplArrayIndex
Exit For
End If
Next
End If
End Function
' Zählt die MacroLineNumber-Tokens für den Artikel, und gibt
' die Anzahl zurück
Function GetMacroLineNumberCount(DuplArrayIndex)
Count = 0
SplittetTokens = Split(Trim(DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex)))
For Each Element In SplittetTokens
Count = Count + 1
Next
GetMacroLineNumberCount = Count
End Function
' Die Funktion gibt die Anzahl der Vorkommen des Artikels zurück.
' Für Macro-Sub-Artikel wird noch der Macro-Counter ausgewertet
Function GetCountInDuplList(ArticleNumber)
GetCountInDuplList = 0
For DuplArrayIndex = 0 To UBound(DUPL_ARTICLE_LIST, 2)
If (DUPL_ARTICLE_LIST(COLUMN_DUPL_ARTICLE_NUMBER, DuplArrayIndex) = ArticleNumber) Then
' COLUMN_DUPL_ROW_COUNT enthält die Gesamtzahl der Vorkommen
DuplCounter = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
If (DuplCounter > 1) Then
' Wenn mehr als 1 Zeile übrig ist und es ein SN-Artikel ist, müssen wir genauer prüfen,
' ob wir die Auswahlbox anzeigen sollen.
ChargeFlag = DUPL_ARTICLE_LIST(COLUMN_DUPL_CHARGE_FLAG, DuplArrayIndex)
If (ChargeFlag = 2) Then
' Gibt es noch SN-Artikel in Makros? und in wievielen unterschiedlichen Macros?
macroRowCounter = cint(DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex)) ' Anzahl Artikel innerhalb von Macros
macroLineCounter = cint(GetMacroLineNumberCount(DuplArrayIndex)) ' Anzahl unterschiedlicher Macros
' Die Abfragebox muss kommen, wenn
' a) SN-Artikel in mehreren unterschiedlichen Macros vorkommen
' b) SN-Artikel innerhalb und ausserhalb von Macros vorkommen
' --> Wir geben die komplette Menge DuplCounter zurück!
' Die Box darf nicht kommen, wenn
' c) wenn SN-Artikel nur ausserhalb von Macros vorkommen
' d) SN-Artikel nur noch in einem Bereich auftauchen,
' --> Wir geben 1 als DuplCounter zurück!
If (macroLineCounter = 0 OR _
(macroLineCounter = 1 AND DuplCounter = macroRowCounter)) Then
DuplCounter = 1
End If
End If
End If
GetCountInDuplList = DuplCounter
Exit For
End If
Next
End Function
' Funktion, die die gewählte Auswahl der InputBox auswertet
' Rückgabewert: gewählte Zeilennummer oder Fehler
Function ChooseGridLineIndexFromDuplicates(ArticleNumber)
NoValidIndexSelected = True
ChooseGridLineIndexFromDuplicates = -1
Do
RetValue = ShowDuplicateInputBox(ArticleNumber)
If RetValue = ARTICLE_IS_NOT_IN_DUPLICATES_LIST Then
' Der Artikel kommt nicht im Array vor. Abbruch.
NoValidIndexSelected = False
ChooseGridLineIndexFromDuplicates = -1
ElseIf RetValue = USE_ORIGINAL_ROW Then
' Verwende einfach die schon gefundene Zeile
NoValidIndexSelected = False
ChooseGridLineIndexFromDuplicates = USE_ORIGINAL_ROW
ElseIf RetValue = NO_GRIDLINE_INDEX_CHOSEN Then
' Leere Auswahl oder Abbruch - OK
Answer = MsgBox("Wollen Sie die Scanergebnisse für Artikel [" & ArticleNumber & "] wirklich verwerfen?", vbYesno + vbQuestion, DEFAULT_TITLE)
If Answer = vbYes Then
NoValidIndexSelected = False
ChooseGridLineIndexFromDuplicates = -1
End If
ElseIf RetValue > 0 Then
' Gültiger Wert wurde ausgewählt
NoValidIndexSelected = False
ChooseGridLineIndexFromDuplicates = RetValue
Else
' Falsche Auswahl - Erneut die InputBox anzeigen.
MsgBox "Die gewählte Zeile steht nicht zur Auswahl. Bitte wählen Sie erneut.", vbOKOnly + vbExclamation, DEFAULT_TITLE
End If
Loop While NoValidIndexSelected
End Function
' Die Funktion zeigt eine InputBox mit den Informationen über
' doppelte Artikel.
' Rückgabewert: GridLineIndex der Position die bebucht werden soll
Function ShowDuplicateInputBox(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
ScannedAmount = Cint(amountBox.Contents)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If (DuplArrayIndex < 0) Then
ShowDuplicateInputBox = ARTICLE_IS_NOT_IN_DUPLICATES_LIST
Exit Function
End If
ChargeFlag = DUPL_ARTICLE_LIST(COLUMN_DUPL_CHARGE_FLAG, DuplArrayIndex)
If ChargeFlag = 2 Then
' Anzeige für SN-Artikel macht nur Sinn, wenn Macro-Artikel involviert sind.
If DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) <= 0 Then
ShowDuplicateInputBox = USE_ORIGINAL_ROW
Exit Function
End If
End If
Dim ChooseableTokens : ChooseableTokens = "" 'Enthält die erlaubten Werte für die Auswahl
Dim AlreadyUsedAreasTokens : AlreadyUsedAreasTokens = "" ' #0# = Normaler Artikel, sonst MacroLineIndex
Dim InputTitle : InputTitle = DEFAULT_TITLE & " - Auswahl einer Zeilennummer"
Dim InputDefault : InputDefault = "" ' Hier machen wir bewusst nichts!
InputPrompt = "Der Artikel [" & ArticleNumber & "] kommt mehrfach im Auftrag vor: " & vbNewLine & vbNewLine
SplittetValues = Split(DUPL_ARTICLE_LIST(COLUMN_DUPL_GRID_LINE_INDEXE, DuplArrayIndex))
For Each GridLineIndex In SplittetValues : Do
Total = Cint(Grid.GetCellValue(Cint(GridLineIndex), COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(Cint(GridLineIndex), COLUMN_SCANNED))
Amount = Total - Scanned
If (Amount > 0) Then
MacroFlag = Cint(Grid.GetCellValue(Cint(GridLineIndex), COLUMN_MACRO_FLAG))
If (ChargeFlag = 0) Then
' Normale Artikel
ChooseableTokens = ChooseableTokens & " #" & GridLineIndex & "# "
InputPrompt = InputPrompt & "Zeile " & GridLineIndex & vbTab & " - Menge " & Amount
If MacroFlag = 2 Then
InputPrompt = InputPrompt & " (Package)"
End If
InputPrompt = InputPrompt & vbNewLine
Else
' SN-Artikel / Späte Ausprägungen
' Hier muss entschieden werden, ob ein Satz überhaupt angezeigt werden soll
MacroLineNumberToken = "#" & Grid.GetCellValue(Cint(GridLineIndex), COLUMN_MACRO_LINE_NUMBER) & "#"
If (InStr(AlreadyUsedAreasTokens, MacroLineNumberToken) = 0) Then
AlreadyUsedAreasTokens = AlreadyUsedAreasTokens & " " & MacroLineNumberToken
ChooseableTokens = ChooseableTokens & " #" & GridLineIndex & "# "
InputPrompt = InputPrompt & "Zeile " & GridLineIndex & vbTab & " - Menge " & Amount
If MacroFlag = 2 Then
InputPrompt = InputPrompt & " (Package)"
End If
InputPrompt = InputPrompt & vbNewLine
Else
Exit Do
End If
End If
End If
Loop While False: Next
InputPrompt = InputPrompt & vbNewLine & "Auf welche Zeile soll die gescannte Menge [" & ScannedAmount & "] gebucht werden?"
inputBoxValue = InputBox(InputPrompt, InputTitle, InputDefault)
Select Case True
Case IsEmpty(inputBoxValue)
' Abbruchbutton der InputBox geklickt
ShowDuplicateInputBox = NO_GRIDLINE_INDEX_CHOSEN
Case "" = Trim(inputBoxValue)
' Kein Wert eingegeben und OK geklickt
ShowDuplicateInputBox = NO_GRIDLINE_INDEX_CHOSEN
Case Else
' Wert eingegeben und OK geklickt
testToken = "#" & inputBoxValue & "#"
If (InStr(ChooseableTokens, testToken) > 0) Then
' Alles Rotscha in Kambodscha!
ShowDuplicateInputBox = inputBoxValue
Else
' Ungültiger Wert
ShowDuplicateInputBox = GRIDLINE_INDEX_IS_NOT_CHOOSEABLE
End If
End Select
End Function

48
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/GetArticleNumberFromSecondaryIndentifier.vbm Normal file
View File

@@ -0,0 +1,48 @@
' GetArticleNumberFromSecondaryIndentifier(Identifier : String)
' ----------------------------------------------------------------------------
' Gibt die Artikelnummer für Spät-Auspräge-Artikel zurück
'
' Returns: GetArticleNumberFromSecondaryIndentifier : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 23.10.2020 / JJ
' Version Date / Editor: 23.11.2020 / JJ
' Version Number: 1.0.0.0
Function GetArticleNumberFromSecondaryIndentifier(Identifier)
SQL = ""
' EAN-Code / Alternative Artikelnummer 1 / Alternative Artikelnummer 2 / Artikelnummer / S/N
SQL = SQL & "("
SQL = SQL & "(C002 = '" & Identifier & "') Or "
SQL = SQL & "(C068 = '" & Identifier & "') Or "
SQL = SQL & "(C075 = '" & Identifier & "') Or "
SQL = SQL & "(C114 = '" & Identifier & "') Or "
SQL = SQL & "(C115 = '" & Identifier & "')"
SQL = SQL & ") "
' Nur Nach Hauptartikel/Ausprägungs(kind)artikel suchen
' SQL = SQL & "And C014 IN (0, 2)"
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for SerialNumber-Regex by ArticleNumber " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetArticleNumberFromSecondaryIndentifier"
End If
If Result.RowCount > 0 Then
GetArticleNumberFromSecondaryIndentifier = Result.Value("c010")
Else
GetArticleNumberFromSecondaryIndentifier = ""
End If
End Function

37
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/GetNextFreeArticleRow.vbm Normal file
View File

@@ -0,0 +1,37 @@
' GetNextFreeArticleRow(ArticleNumber : String)
' ----------------------------------------------------------------------------
' Gibt den Grid Index der nächsten freien Zeile für das Scan-Ergebnis zurück
'
' Returns: GetNextFreeArticleRow : Int
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 30.09.2020 / JJ
' Version Date / Editor: 30.09.2020 / JJ
' Version Number: 1.0.0.0
Function GetNextFreeArticleRow(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim NextFreeRow : NextFreeRow = -1
If DEBUG_ON = True Then
AddDebugLine "Getting next free row for Article: " & ArticleNumber
ShowDebugBox "GetNextFreeArticleRow"
End If
For GridIndex = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(GridIndex, COLUMN_ARTICLENUMBER)
CurrentSerialNumber = Grid.GetCellValue(GridIndex, COLUMN_SERIALNUMBER)
If UCase(ArticleNumber) = UCase(CurrentArticleNumber) And Len(CurrentSerialNumber) = 0 Then
NextFreeRow = GridIndex
Exit For
End If
Next
GetNextFreeArticleRow = NextFreeRow
End Function

68
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/IsOrderAvailable.vbm Normal file
View File

@@ -0,0 +1,68 @@
' IsOrderAvailable(OrderNumber : String)
' ----------------------------------------------------------------------------
' Überprüft, ob Auftrag noch (teilweise) offen ist
'
' Returns: OrderAvailable: Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.09.2020 / JJ
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
Function IsOrderAvailable(OrderNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Err.Clear
IsOrderAvailable = False
'Set SQL Table and Query for DocHead. Default: "T025"
'c023 - c026 = Druckstufen; c098 = Freigabeflag Angebot; c139 = Belegstufe;
'c035 = Belegart
'--> Query is not complete, will be build in the script later this time!
SQL = ""
SQL = SQL & "(c044 = '" & OrderNumber & "') "
SQL = SQL & "AND (c024 = '*' AND c025 != '*' AND c026 != '*') " ' Auftrag gedruckt, LS/Rech noch nicht gedruckt.
SQL = SQL & "AND (c025 IN ('M', 'A', 'S')) " ' Druckstatus Lieferschein
SQL = SQL & "AND (c115 < 900) " ' Flag Freigabekontrolle Auftrag
SQL = SQL & "AND (c139 = 2) " ' Belegstufe 2 = Auftrag
SQL = SQL & SQLQuery_OrderWhere
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_25, SQL)
If DEBUG_ON = True Then
MsgBox "SQL: ... FROM " & TABLE_25 & " WHERE " & SQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Checking For Order by OrderId.." & vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "IsOrderAvailable"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei SQL-Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - IsOrderAvailable"
Exit Function
Else
Message = "Der Auftrag [" & OrderNumber & "] wurde nicht geladen aus einem der folgenden Gründe:" & vbNewLine & vbNewLine
Message = Message & "- Auftrag existiert nicht" & vbNewLine
Message = Message & "- Auftrag ist durch Fibu gesperrt" & vbNewLine
Message = Message & "- Auftrag wurde bereits erledigt" & vbNewLine
Message = Message & "- Beleg ist kein Auftrag"
MsgBox Message, vbExclamation, DEFAULT_TITLE
Exit Function
End If
End If
If Result.RowCount > 0 Then
IsOrderAvailable = True
End If
End Function

38
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/IsOrderComplete.vbm Normal file
View File

@@ -0,0 +1,38 @@
' IsOrderComplete()
' ----------------------------------------------------------------------------
' Überprüft, ob alle Zeilen vollständig gescannt wurden
'
' Returns: OrderComplete: Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 25.09.2020 / JJ
' Version Date / Editor: 01.04.2020 / MP
' Version Number: 3.0.0.2
Function IsOrderComplete()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
IsOrderComplete = True
For GridIndex = 1 To Grid.LineCount: Do
Total = Cint(Grid.GetCellValue(GridIndex, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(GridIndex, COLUMN_SCANNED))
MacroFlag = Cint(Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG))
If MacroFlag = 1 Then
' Continue weil Makro-Haupt-Artikel nicht geprüft werden
' Sonstige Artikel, wie z.B. Versandkosten, werden bereits als komplett ins Grid geladen
Exit Do
End If
If Scanned < Total Then
IsOrderComplete = False
Exit For
End If
Loop While False: Next
End Function

86
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/IsOrderLocked.vbm Normal file
View File

@@ -0,0 +1,86 @@
' IsOrderLocked(OrderNumber : Int)
' ----------------------------------------------------------------------------
' Gibt die UserID des Benutzers zurück, der den Auftrag sperrt.
' Wenn der Auftrag nicht gesperrt ist, wird 0 zurückgegeben.
'
' Returns: IsOrderLocked: Int
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 26.04.2021 / MP
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
' Hole die interne Belegnummer
' t025.c021 = Kontonummer und t025.c022 = Laufende Nummer
Function GetInternalOrderNumber(OrderNumber)
GetInternalOrderNumber = ""
Err.Clear
If Len(OrderNumber) > 0 Then
Set Conn = CWLStart.Connection
Dim SQL : SQL = ""
SQL = SQL & " SELECT TOP 1 c021, c022"
SQL = SQL & " FROM t025 (NOLOCK) "
SQL = SQL & " WHERE c044 = '"& OrderNumber & "'"
SQL = SQL & SQLQuery_OrderWhere
SQL = SQL & " ORDER BY c022"
Set Result = Conn.Select(SQL)
If Result < 0 Then
If err <> 0 Then
MsgBox "Fehler bei SQL-Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetInternalOrderNumber"
Exit Function
Else
Message = "Den Auftrag [" & OrderNumber & "] gibt es nicht in der Datenbank"
MsgBox Message, vbExclamation, DEFAULT_TITLE
Exit Function
End If
End If
GetInternalOrderNumber = result.Value("c021") & result.Value("c022")
End If
End Function
Function IsOrderLocked(OrderNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Err.Clear
IsOrderLocked = 0
InternalOrderNumber = GetInternalOrderNumber(OrderNumber)
SQL = ""
SQL = SQL & " c001 = 'E" & InternalOrderNumber & "' "
SQL = SQL & SQLQuery_BasicWhere
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_499, SQL)
If DEBUG_ON = True Then
MsgBox "SQL: ... FROM " & TABLE_499 & " WHERE " & SQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Checking For Order by internal OrderId [" & InternalOrderNumber & "]:"& vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "IsOrderLocked"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - IsOrderLocked"
Exit Function
End If
End If
If Result.RowCount > 0 Then
IsOrderLocked = Result.Value("C002")
End If
End Function

445
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/LoadOrder.vbm Normal file
View File

@@ -0,0 +1,445 @@
' LoadOrder(OrderNumber : String)
' ----------------------------------------------------------------------------
' Sucht Belegzeilen zur angegebenen Belegnummer
' - Filtert Artikel der Gruppe 100 aus
' - Lädt Ergebnisse in eine Tabelle auf dem Formular
' - Erzeugt N Zeilen für Seriennummer-Artikel der Menge N
'
' Returns: LoadOrder : Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.09.2020 / JJ
' Version Date / Editor: 09.06.2021 / MP
' Version Number: 3.0.0.3
Function GetSQL(OrderNumber)
Dim SQL : SQL = ""
SQL = SQL & " SELECT t2.*, t3.c037 c2137, t3.c079 c2179, t3.c222 c21222"
SQL = SQL & " FROM t025 t (NOLOCK)"
SQL = SQL & " JOIN t026 t2 (NOLOCK) ON t.c021 = t2.c044 AND t.c022 = t2.c045"
SQL = SQL & " LEFT OUTER JOIN v021 t3 (NOLOCK) ON t2.c003 = t3.c002 AND t2.mesoyear = t3.mesoyear"
SQL = SQL & " WHERE t.c044 = '"& OrderNumber &"'"
SQL = SQL & " AND (t2.c005 - t2.c016) > 0 AND (t2.c099 = 0)"
' Nach Mandant und Wirtschaftsjahr filtern
OrderWhere = SQLQuery_OrderWhere
OrderWhere = Replace(OrderWhere, "mesocomp", "t2.mesocomp")
OrderWhere = Replace(OrderWhere, "mesoyear", "t2.mesoyear")
SQL = SQL & OrderWhere
' Nach Zeilennummer sortieren
SQL = SQL & " ORDER BY t2.c000"
GetSQL = SQL
End Function
Function GetMacroArticleCount(MacroName)
Dim CountResult : CountResult = 0
If Len(MacroName) > 0 Then
Set Conn = CWLStart.Connection
Dim SQL : SQL = ""
SQL = SQL & " SELECT count(*) c001"
SQL = SQL & " FROM t326 (NOLOCK) "
SQL = SQL & " WHERE c002 like '"& MacroName &"%'"
SQL = SQL & SQLQuery_BasicWhere
Set Result = Conn.Select(SQL)
CountResult = result.Value("c001")
End If
GetMacroArticleCount = CountResult
End Function
Function FillOrderArticleData(OrderNumber)
Set Conn = CWLStart.Connection
Err.Clear
SQL = GetSQL(OrderNumber)
Set Result = Conn.Select(SQL)
Set CountResult = Result
If DEBUG_ON = True Then
MsgBox "SQL:" & SQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Searching For Order by OrderId (Mid Table).." & vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "LoadOrder"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - LoadOrder"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - LoadOrder"
Exit Function
End If
End If
' Belegung globaler Variablen für späteren Gebrauch
ORDER_ACCOUNT_NUMBER = Result.Value("c044")
ORDER_RUNNING_NUMBER = Result.Value("c045")
' Makro-Gruppenwechsel
Dim macroSubArticleCounter : macroSubArticleCounter = 0
Dim macroFlagForSNArticles : macroFlagForSNArticles = 0
Dim macroName : macroName = ""
Dim macroLineNumber : macroLineNumber = 0
Dim macroMaxLineNumber : macroMaxLineNumber = 0 ' Größte Zeilennummer eines Macros
Dim IsLateShape : IsLateShape = 0
OrderArrayIndex = 0
MacroArrayIndex = 0
Do
macroFlagForSNArticles = 0
AddTwoDimArrayRow ORDER_ARTICLE_DATA
ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) = result.Value("c078")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex) = result.Value("c003")
ORDER_ARTICLE_DATA(INDEX_MAIN_ARTICLE_NUMBER, OrderArrayIndex) = result.Value("c011")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex) = result.Value("c012")
ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) = result.Value("c042")
ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex) = result.Value("c2137")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_TYPE, OrderArrayIndex) = result.Value("c2179")
ORDER_ARTICLE_DATA(INDEX_DESCRIPTION, OrderArrayIndex) = result.Value("c004")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) = result.Value("c005")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex) = result.Value("c016")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_REMAINING, OrderArrayIndex) = result.Value("c099")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex) = ""
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) = result.Value("c055")
ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_ARTICLE_REGEX, OrderArrayIndex) = result.Value("c21222")
ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = False
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_MACRO_LINE_NUMBER, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_PRICE_VK_EINZEL, OrderArrayIndex) = result.Value("c007")
If (Len(ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex)) > 0) Then
' Hier haben wir den Makro-Hauptartikel gefunden
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = 1
AddTwoDimArrayRow MACRO_ARTICLE_LIST
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex)
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_NUMBER, MacroArrayIndex) = ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex)
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_DESCRIPTION, MacroArrayIndex) = ORDER_ARTICLE_DATA(INDEX_DESCRIPTION, OrderArrayIndex)
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_REMAINING, MacroArrayIndex) = ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) - ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex)
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex) = 0
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArrayIndex) = True 'Wird umgesetzt, falls unvollständig
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_GRID_LINE_INDEX, MacroArrayIndex) = 0
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_SCAN_FLAG, MacroArrayIndex) = False
MacroArrayIndex = MacroArrayIndex + 1
macroLineNumber = ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex)
macroName = ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex)
macroSubArticleCounter = GetMacroArticleCount(ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex)) ' Problematisch bei Teillieferungen
macroMaxLineNumber = macroLineNumber + macroSubArticleCounter
End If
If (ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = 0 And _
macroSubArticleCounter > 0 And _
ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) <= macroMaxLineNumber) Then
' Dies muss ein Sub-Makro-Hauptartikel sein
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = 2
' Makro Name für Sub-Makro-Artikel speichern
ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex) = macroName
' Makro Zeilennummer für Sub-Makro-Artikel speichern
ORDER_ARTICLE_DATA(INDEX_MACRO_LINE_NUMBER, OrderArrayIndex) = macroLineNumber
' Nachfolgende S/N Artikel bekommen das gleiche Flag
macroFlagForSNArticles = ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex)
macroSubArticleCounter = macroSubArticleCounter - 1
ElseIf (macroSubArticleCounter = 0 OR _
ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) > macroMaxLineNumber) Then
macroLineNumber = 0
macroMaxLineNumber = 0
End if
' Versandkosten immer komplett, aber es kann Teillieferungen geben.
If ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex) >= 100 Then
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) - ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex)
End If
' Alle Nicht-Artikel (z.B Texte) immer mit Menge 0
If ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) <> 1 Then
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) = 0
End If
' Sichtbar Ja / Nein?
If (ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) = 1 And _
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) <> 12 And _
ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex) < 100) Then
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True
End If
' Wenn Option Alle Artikel Sichtbar aktiv ist
If (OPTION_ALL_ARTICLES > 0 And _
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = False) Then
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True
End If
If (ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) = 2) Then
ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex) = 1
End If
If (Len(ORDER_ARTICLE_DATA(INDEX_ARTICLE_REGEX, OrderArrayIndex)) > 0) Then
ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex) = 1
IsLateShape = 1
Else
ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex) = 0
IsLateShape = 0
End If
If (Len(Result.Value("c067")) > 0) Then
' Belegung hier, weil Text-Artikel keine Belegnummer enthalten
ORDER_DOCUMENT_NUMBER = Result.Value("c067")
End If
' Duplikate scanbarer Artikel ermitteln
If (ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) = 1 And _
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) <> 12 And _
ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex) < 100 And _
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) <> 1) Then
AddArticleNumberToDuplList ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex), _
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex), _
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex)
End If
Dim AmountOrdered, AmountDelivered, ChargeFlag
ChargeFlag = CInt(result.Value("c055"))
AmountOrdered = CInt(result.Value("c005"))
AmountDelivered = CInt(result.Value("c016"))
Amount = AmountOrdered - AmountDelivered
If ChargeFlag = 2 Then
' Amount wird um 1 reduziert, da für den Artikel bereits
' eine Zeile aus der Schleife oben existiert
For Index = 1 To Amount - 1
AddTwoDimArrayRow ORDER_ARTICLE_DATA
OrderArrayIndex = OrderArrayIndex + 1
ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) = result.Value("c078")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex) = result.Value("c003")
ORDER_ARTICLE_DATA(INDEX_MAIN_ARTICLE_NUMBER, OrderArrayIndex) = result.Value("c011")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex) = result.Value("c012")
ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) = result.Value("c042")
ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex) = macroName
ORDER_ARTICLE_DATA(INDEX_ARTICLE_TYPE, OrderArrayIndex) = result.Value("c2179")
ORDER_ARTICLE_DATA(INDEX_DESCRIPTION, OrderArrayIndex) = result.Value("c004")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) = result.Value("c005")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex) = result.Value("c016")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_REMAINING, OrderArrayIndex) = result.Value("c099")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex) = ""
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) = result.Value("c055")
ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex) = 1
ORDER_ARTICLE_DATA(INDEX_ARTICLE_REGEX, OrderArrayIndex) = result.Value("c21222")
ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex) = IsLateShape
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = macroFlagForSNArticles
ORDER_ARTICLE_DATA(INDEX_MACRO_LINE_NUMBER, OrderArrayIndex) = macroLineNumber
ORDER_ARTICLE_DATA(INDEX_PRICE_VK_EINZEL, OrderArrayIndex) = result.Value("c007")
' Wir benötigen die korrekte Anzahl der Zeilen eines Artikels
AddArticleNumberToDuplList ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex), _
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex), _
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex)
Next
End If
OrderArrayIndex = OrderArrayIndex + 1
Loop While Result.NextRecord = True
' Enthält die Anzahl der Macro-Hauptartikel
MACRO_ARTICLE_COUNTER = MacroArrayIndex
FillOrderArticleData = OrderArrayIndex
End Function
Function LoadOrder(OrderNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
ASK_FOR_DELNOTE = False
If (FillOrderArticleData(OrderNumber) <= 0) Then
LoadOrder = False
Exit Function
ElseIf (ExistVisibleRows() = False) Then
' Es gibt keine sichtbaren Zeilen, d.h. es gibt auch nix zu scannen.
' Da aber ein Lieferschein erzeugt werden kann, zeigen wir jetzt alles an,
' und fragen nach dem Laden ob der letzte LS direkt erstellt werden soll
ShowAllArticles()
ASK_FOR_DELNOTE = True
End If
Grid.InitUserGrid
Grid.Header
Grid.Clear(1002)
Grid.IsRedraw = False
' Zähler für Grid
' Wird immer hoch gezählt bei Grid.AddLine
GridLineCounter = 1
' Zähler für Datenstruktur
' Wird in JEDEM Durchlauf hochgezählt
OrderArrayIndex = 0
Do
' Speicher für benutzerdefinierte Felder im Grid
' (495,0) - Menge Gesamt
' (495,1) - Menge Gescannt
' (495,2) - Seriennummer
' (495,3) - Artikelnummer
' (495,4) - Bezeichnung
' (495,5) - Seriennummer Ja/Nein
' (495,6) - Spät Ausprägung Ja/Nein
' (495,7) - Interne Zeilennumemr
Dim AmountOrdered, AmountDelivered
AmountOrdered = Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex))
AmountDelivered = Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex))
ProductGroup = Cint(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex))
Amount = AmountOrdered - AmountDelivered
SalesMacro = ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex)
ArticleType = ORDER_ARTICLE_DATA(INDEX_ARTICLE_TYPE, OrderArrayIndex)
ChargeFlag = Cint(ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex))
IsLateShape = Cint(ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex))
ArticleNumber = ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex)
Description = ORDER_ARTICLE_DATA(INDEX_DESCRIPTION, OrderArrayIndex)
IsVisible = ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex)
LineNumber = CInt(ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex))
IsSerialNumber = CInt(ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex))
MacroFlag = CInt(ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex))
MacroLineNumber = CInt(ORDER_ARTICLE_DATA(INDEX_MACRO_LINE_NUMBER, OrderArrayIndex))
If (IsVisible = True) Then
If ChargeFlag = 2 Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = 1
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = 0
ResetableFlag = 1
If MacroFlag = 2 Then
LineColor = COLOR_PACKAGE_RED
AddMacroLineNumberTokensToDuplicateArticles ArticleNumber, MacroLineNumber
Else
LineColor = COLOR_RED
End If
' GridLine Index der Duplikate-Struktur hinzufügen
AddGridLineIndexToDuplicateArticles ArticleNumber, GridLineCounter
ElseIf ProductGroup >= 100 OR AmountOrdered = 0 Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = Amount
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = Amount
ResetableFlag = 0
If MacroFlag = 2 Then
LineColor = COLOR_PACKAGE_GREEN
Else
LineColor = COLOR_GREEN
End If
ElseIf MacroFlag = 1 Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = Amount
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = 0
ResetableFlag = 0
LineColor = COLOR_BLUE
Else
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = Amount
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = 0
ResetableFlag = 1
If MacroFlag = 2 Then
LineColor = COLOR_PACKAGE_RED
AddMacroLineNumberTokensToDuplicateArticles ArticleNumber, MacroLineNumber
Else
LineColor = COLOR_RED
End If
' GridLine Index der Duplikate-Struktur hinzufügen
AddGridLineIndexToDuplicateArticles ArticleNumber, GridLineCounter
End If
CWLCurrentWindow.ActiveWindow.Vars.Value(495,2) = ""
CWLCurrentWindow.ActiveWindow.Vars.Value(495,3) = ArticleNumber
CWLCurrentWindow.ActiveWindow.Vars.Value(495,4) = Description
CWLCurrentWindow.ActiveWindow.Vars.Value(495,5) = IsSerialNumber
CWLCurrentWindow.ActiveWindow.Vars.Value(495,6) = IsLateShape
CWLCurrentWindow.ActiveWindow.Vars.Value(495,7) = LineNumber
CWLCurrentWindow.ActiveWindow.Vars.Value(495,8) = GridLineCounter
CWLCurrentWindow.ActiveWindow.Vars.Value(495,9) = ResetableFlag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,10) = MacroFlag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,11) = MacroLineNumber
' Neue Grid-Zeile schreiben
Grid.AddLine
' Zeilenfarbe mit ROT vorbelegen
Grid.SetLineColor GridLineCounter, LineColor
GridLineCounter = GridLineCounter + 1
End If
OrderArrayIndex = OrderArrayIndex + 1
Loop While OrderArrayIndex < (UBound(ORDER_ARTICLE_DATA, 2) + 1)
LoadOrder = True
Grid.IsRedraw = True
End Function
' Schaltet alle nicht sichtbaren Felder auf sichtbar um
Sub ShowAllArticles
For OrderArrayIndex = 0 to UBound(ORDER_ARTICLE_DATA, 2)
If (ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = False) Then
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True
End If
Next
End Sub
' Gibt True zurück, wenn es min. 1 sichtbare Zeile gibt
Function ExistVisibleRows
ExistVisibleRows = False
For OrderArrayIndex = 0 to UBound(ORDER_ARTICLE_DATA, 2)
If (ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True) Then
ExistVisibleRows = True
Exit For
End If
Next
End Function

112
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/ResetValuesByLineIndex.vbm Normal file
View File

@@ -0,0 +1,112 @@
' ResetValuesByLineIndex(LineIndex : INT)
' ----------------------------------------------------------------------------
' Setzt die Werte in einer bestimmten Zeile auf ihre
' Ausgangswerte zurück.
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 15.03.2021 / MP
' Version Date / Editor: 15.03.2021 / MP
' Version Number: 3.0.0.1
Sub ResetValues(GridLineIndexToReset)
Set myWin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = myWin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount
If GridIndex = GridLineIndexToReset Then
Grid.SetCellValue GridIndex, COLUMN_SCANNED, 0
Grid.SetCellValue GridIndex, COLUMN_SERIALNUMBER, ""
If (Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG) = 2) Then
Grid.SetLineColor GridIndex, COLOR_PACKAGE_RED
Else
Grid.SetLineColor GridIndex, COLOR_RED
End If
Exit For
End If
Next
End Sub
Sub ResetValuesByMacroLineNumber(MacroArticleLineNumber)
Set myWin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = myWin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount
MacroLineNumber = Cint(Grid.GetCellValue(GridIndex, COLUMN_MACRO_LINE_NUMBER))
If MacroLineNumber = MacroArticleLineNumber Then
Grid.SetCellValue GridIndex, COLUMN_SCANNED, 0
Grid.SetCellValue GridIndex, COLUMN_SERIALNUMBER, ""
Grid.SetLineColor GridIndex, COLOR_PACKAGE_RED
End If
Next
End Sub
Sub ResetValuesByLineIndex(LineIndex)
Set myWin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = myWin.Controls.Item(GRID_ID).Grid
If (Grid.LineCount <= 0) Then
MsgBox "Bitte scannen Sie zuerst eine Auftragsnummer!", vbOKOnly + vbInformation, DEFAULT_TITLE
Exit Sub
End If
Dim LineIndexToReset : LineIndexToReset = 0
If (LineIndex = -1) Then
InputBoxHeaderText = "Zeile zurücksetzen"
If (Grid.LineCount = 1) Then
InputBoxText = "Zeilennummer:"
InputBoxDefault = "1"
Else
InputBoxText = "Zeilennummer (Zeile [1 - " & Grid.LineCount & "]):"
InputBoxDefault = "0"
End If
LineIndexInputBox = InputBox(InputBoxText, InputBoxHeaderText, InputBoxDefault)
Select Case True
Case IsEmpty(LineIndexInputBox)
' Abbruch der Box
Exit Sub
Case "" = Trim(LineIndexInputBox)
' Kein Wert eingegeben = Abbruch
Exit Sub
Case Else
' Wert eingegeben und OK geklickt
If Len(LineIndexInputBox) > 0 Then
LineIndexToReset = Cint(LineIndexInputBox)
Else
LineIndexToReset = 0
End If
End Select
Else
LineIndexToReset = LineIndex
End If
If (LineIndexToReset <= 0 OR LineIndexToReset > Grid.LineCount) Then
MsgBox "Keine gültige Zeile ausgewählt!", vbOKOnly + vbInformation, DEFAULT_TITLE
ElseIf (Grid.GetCellValue(LineIndexToReset, COLUMN_RESETABLE_FLAG) = 0) Then
MsgBox "Die Zeile [" & LineIndexToReset & "] ist nicht änderbar!", vbOKOnly + vbInformation, DEFAULT_TITLE
ElseIf (LineIndexToReset > 0 And LineIndexToReset <= Grid.LineCount) Then
Answer = MsgBox("Sollen die Werte in Zeile [" & LineIndexToReset & "] zurückgesetzt werden?", vbYesno + vbQuestion, DEFAULT_TITLE)
If Answer = vbYes Then
ResetValues LineIndexToReset
CURRENT_GRID_LINE_INDEX = 0
End If
Else
MsgBox "Diese Zeilennummer gibt es nicht!"
End If
End Sub

30
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/SerialNumberExists.vbm Normal file
View File

@@ -0,0 +1,30 @@
' SerialNumberExists(SerialNumber : String)
' ----------------------------------------------------------------------------
' Prüft, ob die übergebene Seriennummer bereits gescannt wurde
'
' Returns: SerialNumberExists : Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 25.09.2020 / JJ
' Version Date / Editor: 25.09.2020 / JJ
' Version Number: 1.0.0.0
Function SerialNumberExists(SerialNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
SerialNumberExists = False
For GridIndex = 1 To Grid.LineCount
CurrentSerialNumber = Grid.GetCellValue(GridIndex, COLUMN_SERIALNUMBER)
If SerialNumber = CurrentSerialNumber Then
SerialNumberExists = True
Exit For
End If
Next
End Function

27
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/SetAmount.vbm Normal file
View File

@@ -0,0 +1,27 @@
' SetAmount(Amount: Integer)
' ----------------------------------------------------------------------------
' Setzt eingegebene Menge in das Mengenfeld ein
' - Überschreibt Menge beim ersten Eintrag, danach
' wird die Zahl angehängt
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 25.09.2020 / JJ
' Version Date / Editor: 25.09.2020 / JJ
' Version Number: 1.0.0.0
Sub SetAmount(Amount)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
If amountBox.Contents = AMOUNT_PLACEHOLDER Then
amountBox.Contents = Cstr(Amount)
Else
amountBox.Contents = amountBox.Contents & Cstr(Amount)
End If
End Sub

32
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/SetDebugMode.vbm Normal file
View File

@@ -0,0 +1,32 @@
' SetDebugMode()
' ----------------------------------------------------------------------------
' Zeigt je nach DEBUG-Mode die nicht sichtbaren Spalten
' im Grid an oder nicht, je nach DEBUG_ON-Einstellung.
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.04.2021 / MP
' Version Date / Editor: 01.04.2021 / MP
' Version Number: 3.0.0.2
Sub SetDebugMode()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' Unsichtbare Spalten anzeigen im DEBUG-Modus
Dim invisibleColWidth : invisibleColWidth = 0
If DEBUG_ON = True Then
invisibleColWidth = 5
End If
Grid.SetColumnWidth COLUMN_LINE_NUMBER, invisibleColWidth
Grid.SetColumnWidth COLUMN_RESETABLE_FLAG, invisibleColWidth
Grid.SetColumnWidth COLUMN_MACRO_FLAG, invisibleColWidth
Grid.SetColumnWidth COLUMN_MACRO_LINE_NUMBER, invisibleColWidth
End Sub

87
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/SetupWindow.vbm Normal file
View File

@@ -0,0 +1,87 @@
' SetupWindow()
' ----------------------------------------------------------------------------
' Definiert die Spalten des Grids und initialisiert Felder
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.09.2020 / JJ
' Version Date / Editor: 30.03.2021 / MP
' Version Number: 3.0.0.1
Sub SetupWindow()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' Speicher für benutzerdefinierte Felder
' (495,0) - Menge Gesamt
' (495,1) - Menge Gescannt
' (495,2) - Seriennummer
' (495,3) - Artikelnummer
' (495,4) - Bezeichnung
' (495,5) - Chargen-/Identflag
' (495,6) - Spät ausgeprägt bzw. Regex vorhanden
' (495,7) - Interne Zeilennummer aus Auftrag
' (495,8) - Sichtbare Zeilennummer im Grid
' (495,9) - Zeile darf resettet werden (J/N)
' (495,10) - Makro Flag (0 - Default / 1 = Macro-Artikel / 2 = Sub-Macro-Artikel)
' (495,11) - Makro Index, Zeilennummer des übergeordneten Makro-Artikels
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 0, "2", 10
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 1, "2", 10
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 2, "1", 20
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 3, "1", 20
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 4, "1", 60
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 5, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 6, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 7, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 8, "2", 4
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 9, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 10, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 11, "2", 3
Grid.InitUserGrid
Grid.IsRedraw = False
Grid.Header
If COLUMNS_CREATED = False Then
COLUMN_GRID_LINE_INDEX = Grid.AddColumn("#", "T22,Zeilenindex", "z", "V", 0, 495, 8, 4, sizeflag+hideflag)
COLUMN_ARTICLENUMBER = Grid.AddColumn("Artikelnummer", "T21,Artikelnummer", "l", "V", 0, 495, 3, 15, sizeflag+hideflag)
COLUMN_DESCRIPTION = Grid.AddColumn("Bezeichnung", "T21,Bezeichnung", "l", "V", 0, 495, 4, 37, sizeflag+hideflag)
COLUMN_TOTAL = Grid.AddColumn("Gesamt", "T22,Gesamt", "z", "V", 0, 495, 0, 10, sizeflag+hideflag)
COLUMN_SCANNED = Grid.AddColumn("Gescannt", "T22,Gescannt", "z", "V", 0, 495, 1, 10, sizeflag+hideflag)
COLUMN_SERIALNUMBER = Grid.AddColumn("Seriennummer", "T21,Seriennummer", "l", "V", 0, 495, 2, 20, sizeflag+hideflag)
COLUMN_CHARGE_FLAG = Grid.AddColumn("S/N?", "T17,Seriennummer", "l", "V", 0, 495, 5, 6, sizeflag+hideflag)
COLUMN_LATE_SHAPE = Grid.AddColumn("Auspr?", "T17,Spaetausgepr.", "l", "V", 0, 495, 6, 6, sizeflag+hideflag)
COLUMN_LINE_NUMBER = Grid.AddColumn("LN", "T22,Zeilennummer", "r", "V", 0, 495, 7, 0, 0) ' nicht sichtbar
COLUMN_RESETABLE_FLAG = Grid.AddColumn("RF", "T22,ResetableFlag", "r", "V", 0, 495, 9, 0, 0) ' nicht sichtbar
COLUMN_MACRO_FLAG = Grid.AddColumn("MF", "T22,MacroFlag", "r", "V", 0, 495, 10, 0, 0) ' nicht sichtbar
COLUMN_MACRO_LINE_NUMBER = Grid.AddColumn("MLN", "T22,MacroZeilenr", "r", "V", 0, 495, 11, 0, 0) ' nicht sichtbar
COLUMNS_CREATED = True
End If
Grid.IsRedraw = True
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
amountBox.Contents = AMOUNT_PLACEHOLDER
Set articleBox = mywin.Controls.Item(ARTICLE_INPUT)
articleBox.Contents = ""
' Merker für Resetbutton
CURRENT_GRID_LINE_INDEX = 0
PRINT_DOCUMENT_AFTER_COMPLETION = True
SetLabelText TEXT_CONFIG_INFO, 495, 71, ""
' Arrays reinitialisieren
Redim ORDER_ARTICLE_DATA(MAX_ORDER_COLUMN_COUNT, -1)
Redim MACRO_ARTICLE_LIST(MAX_MACRO_COLUMN_COUNT, -1)
Redim DUPL_ARTICLE_LIST(MAX_DUPL_COLUMN_COUNT, -1)
MacroCommands.MSetFieldFocus WINDOW_ID, ORDER_INPUT
End Sub

62
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/TestArticleHasSerialNumberRegex.vbm Normal file
View File

@@ -0,0 +1,62 @@
' TestArticleHasSerialNumberRegex(Identifier: String)
' ----------------------------------------------------------------------------
' Findet Artikelnummer anhand von versch. Kriterien
' - Artikel-Nummer, Alternative Artikel-Nummer, EAN-Code, Seriennummer
' - Gibt die Zeile im Grid zurück in der Artikel das erste Mal gefunden wurde
'
' Returns: TestArticleHasSerialNumberRegex : Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 25.09.2020 / JJ
' Version Date / Editor: 25.09.2020 / JJ
' Version Number: 1.0.0.0
Function TestArticleHasSerialNumberRegex(Identifier)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
If DEBUG_ON = True Then
AddDebugLine "Testing for Regex in Identifier: " & Identifier
ShowDebugBox "TestArticleHasSerialNumberRegex"
End If
SQL = ""
' Artikelnummer / EAN-Code / Alternative Artikelnummer
SQL = SQL & "((C002 = '" & Identifier & "') Or (C075 = '" & Identifier & "') Or (C114 = '" & Identifier & "')) AND "
' Serienummer-Regex muss vorhanden sein
SQL = SQL & "(C222 IS NOT NULL) AND "
' Artikel darf nicht inaktiv sein
SQL = SQL & "(c038 IS NULL) "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
If DEBUG_ON = True Then
AddDebugLine "SQL: " & SQL
ShowDebugBox "TestArticleHasSerialNumberRegex"
End If
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for SerialNumber-Regex by ArticleNumber " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "TestArticleHasSerialNumberRegex"
End If
If Result.RowCount > 0 Then
TestArticleHasSerialNumberRegex = True
Else
TestArticleHasSerialNumberRegex = False
End If
End Function

37
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/TestHasFreeArticleRow.vbm Normal file
View File

@@ -0,0 +1,37 @@
' TestHasFreeArticleRow(ArticleNumber : String)
' ----------------------------------------------------------------------------
' Sucht die nächste freie Zeile für eine gescannte Seriennummer
'
' Returns: TestHasFreeArticleRow : Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 25.09.2020 / JJ
' Version Date / Editor: 25.09.2020 / JJ
' Version Number: 1.0.0.0
Function TestHasFreeArticleRow(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim NextFreeRow : NextFreeRow = False
If DEBUG_ON = True Then
AddDebugLine "Getting next free row for Article: " & ArticleNumber
ShowDebugBox "TestHasFreeArticleRow"
End If
For GridIndex = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(GridIndex, COLUMN_ARTICLENUMBER)
CurrentSerialNumber = Grid.GetCellValue(GridIndex, COLUMN_SERIALNUMBER)
If UCase(ArticleNumber) = UCase(CurrentArticleNumber) And Len(CurrentSerialNumber) = 0 Then
NextFreeRow = True
Exit For
End If
Next
TestHasFreeArticleRow = NextFreeRow
End Function

43
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/TestIsWebserviceResponseSuccessful.vbm Normal file
View File

@@ -0,0 +1,43 @@
' TestIsWebserviceResponseSuccessful(XmlString : String)
' ----------------------------------------------------------------------------
' Prüft, ob im WebService Result, ein Success enthalten ist
'
' Returns: TestIsWebserviceResponseSuccessful : Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 23.10.2020 / JJ
' Version Date / Editor: 23.10.2020 / JJ
' Version Number: 1.0.0.0
Function TestIsWebserviceResponseSuccessful(XmlString)
' Check if XmlString is actually a xml string
If InStr(XmlString, "<?xml") = 1 Then
Set Doc = CreateObject("MSXML2.DOMDocument")
Doc.loadXML(XmlString)
Set Nodes = Doc.SelectNodes("MESOWebServiceResult/ResultDetails")
Set OverallSuccess = Doc.SelectSingleNode("MESOWebServiceResult/OverallSuccess")
If OverallSuccess.Text = "true" Then
Dim IsSuccess : IsSuccess = True
For Each Node in Nodes
Set Success = Node.SelectSingleNode("Success")
If Success.Text <> "true" Then
IsSuccess = False
End If
Next
TestIsWebserviceResponseSuccessful = IsSuccess
Else
TestIsWebserviceResponseSuccessful = False
End If
Else
TestIsWebserviceResponseSuccessful = False
End If
End Function

65
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/TransferGridData.vbm Normal file
View File

@@ -0,0 +1,65 @@
' TransferGridData()
' ----------------------------------------------------------------------------
' Überführt die Gescannten Daten aus dem Grid in die Datenstruktur
'
' Returns: TransferGridData: Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.09.2021 / JJ
' Version Date / Editor: 25.03.2021 / MP
' Version Number: 3.0.0.1
Function TransferGridData()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount: Do
Total = Cint(Grid.GetCellValue(GridIndex, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(GridIndex, COLUMN_SCANNED))
ChargeFlag = Cint(Grid.GetCellValue(GridIndex, COLUMN_CHARGE_FLAG)) ' Checkbox-Werte = 0 oder 1
' Zeilennummer aus Auftrag
LineNumber = Cint(Grid.GetCellValue(GridIndex, COLUMN_LINE_NUMBER))
SerialNumber = Grid.GetCellValue(GridIndex, COLUMN_SERIALNUMBER)
MacroFlag = Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG)
If Scanned = 0 Then
Exit Do
End If
For OrderArrayIndex = 0 To Ubound(ORDER_ARTICLE_DATA, 2)
If ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True Then
If ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) = LineNumber Then
If MacroFlag = 1 Then
For MacroArrayIndex = 0 To UBound(MACRO_ARTICLE_LIST)
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = LineNumber) Then
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArrayIndex) = True) Then
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_REMAINING, MacroArrayIndex)
Else
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex)
End If
Exit For
End If
Next
ElseIf ChargeFlag = 1 And Len(ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex)) = 0 Then
ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex) = SerialNumber
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = Scanned
Exit For
ElseIf ChargeFlag = 0 Then
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = Scanned
Exit For
End If
End If
End If
Next
Loop While False: Next
TransferGridData = True
End Function

42
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/TransferMacroData.vbm Normal file
View File

@@ -0,0 +1,42 @@
' TransferMacroData()
' ----------------------------------------------------------------------------
' Überführt die Daten aus dem Macro-Array zurück ins Grid
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 08.03.2021 / MP
' Version Date / Editor: 08.03.2021 / MP
' Version Number: 3.0.0.0
Sub TransferMacroData()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount: Do
MacroFlag = Cint(Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG))
If MacroFlag = 1 Then
LineNumber = Cint(Grid.GetCellValue(GridIndex, COLUMN_LINE_NUMBER))
For MacroArrayIndex = 0 To UBound(MACRO_ARTICLE_LIST, 2)
' Wenn die Menge in COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED > 0 ist,
' dann muss dieser Wert ins Grid zurück geschrieben werden.
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = LineNumber) And _
(MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex) > 0) Then
Grid.SetCellValue GridIndex, COLUMN_SCANNED, MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex)
Exit For
End If
Next
Else
' Continue
Exit Do
End If
Loop While False: Next
End Sub

97
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/UpdateArticleRow.vbm Normal file
View File

@@ -0,0 +1,97 @@
' UpdateArticleRow(RowNumber: Integer)
' ----------------------------------------------------------------------------
' Trägt die gescannte Menge eines Artikel in das Grid ein
' - Ändert die Farbe, abhängig von Gesamtmenge und Gescannte Menge
' - Überprüft, ob der Artikel in der Gescannten Menge auf Lager liegt
'
' Returns: UpdateArticleRow : Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.09.2021 / JJ
' Version Date / Editor: 25.03.2021 / MP
' Version Number: 3.0.0.1
' Aktualisiert den Wert COLUMN_MACRO_ARTICLE_SCAN_FLAG für den aktuellen
' MacroIndex
Sub UpdateMacroArticleRow(MacroArticleLineNumber)
For MacroArrayIndex = 0 To UBound(MACRO_ARTICLE_LIST): Do
If MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = MacroArticleLineNumber Then
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_SCAN_FLAG, MacroArrayIndex) = True
Exit For
End If
Loop While False: Next
End Sub
Function UpdateArticleRow(RowNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
' Bereits gescannte, Gesamt und Anzahl zu Scannen auslesen
ArticleNumber = Grid.GetCellValue(RowNumber, COLUMN_ARTICLENUMBER)
Total = Cint(Grid.GetCellValue(RowNumber, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(RowNumber, COLUMN_SCANNED))
ScannedAmount = Cint(amountBox.Contents)
MacroFlag = Cint(Grid.GetCellValue(RowNumber, COLUMN_MACRO_FLAG))
MacroArticleLineNumber = Cint(Grid.GetCellValue(RowNumber, COLUMN_MACRO_LINE_NUMBER))
' Standard Rückgabewert setzen
UpdateArticleRow = True
' Aktuellen Lagerstand abfragen
StockedAmount = GetWinLineStockedAmount(ArticleNumber, False)
' Neue bereits gescannte berechnen
NewScanned = Scanned + ScannedAmount
If DEBUG_ON = True Then
AddDebugLine "Total " & Total
AddDebugLine "Scanned: " & Scanned
AddDebugLine "NewScanned: " & NewScanned
AddDebugLine "StockedAmount: " & StockedAmount
ShowDebugBox "UpdateArticleRow"
End If
' Zeilenfarbe anpassen:
' GRÜN: Komplett gescannt
' GELB: Teilweise gescannt
If NewScanned > StockedAmount Then
Message = ""
Message = Message & "Der Artikel ist nur in der Menge " & StockedAmount & " vorhanden." & vbNewline
Message = Message & "Der Scan wird abgebrochen!"
Msgbox Message, vbExclamation, DEFAULT_TITLE
Elseif NewScanned = Total Then
If MacroFlag = 2 Then
Grid.SetLineColor RowNumber, COLOR_PACKAGE_GREEN
UpdateMacroArticleRow(MacroArticleLineNumber)
ReduceSubMacroCounterInDuplList ArticleNumber, MacroArticleLineNumber
Else
Grid.SetLineColor RowNumber, COLOR_GREEN
End If
Grid.SetCellValue RowNumber, COLUMN_SCANNED, NewScanned
ReduceCounterInDuplList ArticleNumber, MacroFlag
Elseif NewScanned < Total Then
If MacroFlag = 2 Then
Grid.SetLineColor RowNumber, COLOR_PACKAGE_YELLOW
UpdateMacroArticleRow(MacroArticleLineNumber)
Else
Grid.SetLineColor RowNumber, COLOR_YELLOW
End If
Grid.SetCellValue RowNumber, COLUMN_SCANNED, NewScanned
Else
Message = ""
Message = Message & "Die eingegebene Menge überschreitet die Gesamtanzahl oder" & vbNewline
Message = Message & "der Artikel wurde bereits vollständig gescannt!"
Msgbox Message, vbExclamation, DEFAULT_TITLE
UpdateArticleRow = False
End If
End Function

45
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/UpdateDeliveryNote.vbm Normal file
View File

@@ -0,0 +1,45 @@
' UpdateDeliveryNote(OrderNumber: String)
' ----------------------------------------------------------------------------
' Füllt zusätzliche Felder in der Tabelle t025 (Belegkopf)
' - User ID (U000)
' - Datum und Uhrzeit der LS-Erzeugung (U001)
' - Name des Computers an dem der Packtisch läuft (U002)
' - Packtischversion (U003)
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 26.04.2021 / MP
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
Function UpdateDeliveryNote(OrderNumber)
Err.Clear
Dim SQL : SQL = ""
Dim NowObject : NowObject = Now
Dim UserNumber : UserNumber = CWLStart.CurrentUser.Number
Dim DateString : DateString = Year(NowObject) & "-" & GetLeftPad(Month(NowObject)) & "-" & GetLeftPad(Day(NowObject))
Dim TimeString : TimeString = GetLeftPad(Hour(NowObject)) & ":" & GetLeftPad(Minute(NowObject)) & ":" & GetLeftPad(Second(NowObject))
Dim ComputerName : ComputerName = GetWindowsEnvironment("COMPUTERNAME")
SQL = SQL & " UPDATE t025"
SQL = SQL & " SET U000 = " & UserNumber & ", U001 = '" & DateString & " " & TimeString & "',"
SQL = SQL & " U002 = '" & ComputerName & "', U003 = '" & PACKTISCH_VERSION & "'"
SQL = SQL & " WHERE c000 = (SELECT TOP 1 c000 FROM t025 WHERE c029 IS NOT NULL AND c044 = '" & OrderNumber & "' " & SQLQuery_OrderWhere & " ORDER BY ts DESC) " & SQLQuery_OrderWhere
If DEBUG_ON = True Then
AddDebugLine "SQL: " & SQL
ShowDebugBox "UpdateDeliveryNote"
End If
CWLStart.Connection.ExecuteSQL(SQL)
If err <> 0 Then
MsgBox "Fehler beim Updaten des Lieferscheins: " & err.number & " - " & err.description
End If
End Function

73
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/Packtisch_3_0/UpdateOrderDataBeforeDelNote.vbm Normal file
View File

@@ -0,0 +1,73 @@
' UpdateOrderDataBeforeDelNote()
' ----------------------------------------------------------------------------
' Vor der Erstellung des Lieferscheins, können hier noch
' Werte in der Datenstruktur korrigiert werden.
'
' Beispiel: Versandkosten in Package-Artikeln
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 08.03.2021 / JJ
' Version Date / Editor: 08.03.2021 / MP
' Version Number: 3.0.0.0
Sub UpdateOrderDataBeforeDelNote()
Dim MacroAmountFaktor
Dim MacroComplete
Dim MacroAmountScanned
For OrderArrayIndex = 0 To Ubound(ORDER_ARTICLE_DATA, 2)
If DEBUG_ON = True Then
AddDebugLine "Current ORDER_ARTICLE_DATA values for Index: " & OrderArrayIndex
AddDebugLine "LineNumber: " & vbTab & ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex)
AddDebugLine "ArticleNumber: " & vbTab & ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex)
AddDebugLine "MacroFlag: " & vbTab & ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex)
AddDebugLine "ProductGroup: " & vbTab & ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)
AddDebugLine "AmountOrdered: " & vbTab & ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex)
AddDebugLine "AmountDelivered: " & vbTab & ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex)
AddDebugLine "AmountScanned: " & vbTab & ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex)
ShowDebugBox "UpdateOrderDataBeforeDelNote"
End If
MacroFlag = CInt(ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex))
' Wenn Macro-Artikel nur zum Teil ausgeliefert werden,
' müssen die Anteile Nicht-scannbarer Artikel entsprechend reduziert werden.
If MacroFlag = 1 Then
MacroAmount = Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex)) - Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex))
MacroAmountScannend = Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex))
If MacroAmount > MacroAmountScannend Then
MacroComplete = False
If MacroAmount > 0 Then
MacroAmountFaktor = MacroAmountScannend / MacroAmount
End If
Else
MacroComplete = True
MacroAmountFaktor = 1
End If
ElseIf MacroFlag = 2 And MacroComplete = False Then
ProductGroup = Cint(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex))
' Wir müssen nur etwas tun, wenn ein Faktor < 1 (=100%) ermittelt wurde,
' da die Artikel der ProductGroup >= 100 ja bereits als vollständig initialisiert werden.
If ProductGroup >= 100 And MacroAmountFaktor < 1 Then
ProductAmount = Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex)) - Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex))
ProductAmount = Round(ProductAmount * MacroAmountFaktor)
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = ProductAmount
End If
End If
Next
End Sub

32
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/PrettyPrintXmlString.vbs Normal file
View File

@@ -0,0 +1,32 @@
' prettyXml(sDirty : String)
' ----------------------------------------------------------------------------
' Source: https://stackoverflow.com/questions/25067839/format-xml-string-in-vbscript
'
' Returns: prettyXml : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 30.09.2020 / XX
' Version Date / Editor: 30.09.2020 / XX
' Version Number: 1.0.0.0
Function prettyXml(ByVal sDirty)
' Put whitespace between tags. (Required for XSL transformation.)
sDirty = Replace(sDirty, "><", ">" & vbCrLf & "<")
' Create an XSL stylesheet for transformation.
Dim objXSL : Set objXSL = WScript.CreateObject("Msxml2.DOMDocument")
objXSL.loadXML "<xsl:stylesheet version=""1.0"" xmlns:xsl=""http://www.w3.org/1999/XSL/Transform"">" & _
"<xsl:output method=""xml"" indent=""yes""/>" & _
"<xsl:template match=""/"">" & _
"<xsl:copy-of select="".""/>" & _
"</xsl:template>" & _
"</xsl:stylesheet>"
' Transform the XML.
Dim objXML : Set objXML = WScript.CreateObject("Msxml2.DOMDocument")
objXML.loadXml sDirty
objXML.transformNode objXSL
prettyXml = objXML.xml
End Function

52
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/RemoveDuplicatesFromArray.vbs Normal file
View File

@@ -0,0 +1,52 @@
' RemoveDuplicatesFromArray(arrItems : Array)
' ----------------------------------------------------------------------------
' Entfernt doppelte Einträge aus Ein-Dimensionalen Arrays
'
' Source: https://devblogs.microsoft.com/scripting/how-can-i-delete-duplicate-items-from-an-array/
'
' Returns: RemoveDuplicatesFromArray : Array
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 10.08.2020 / MK
' Version Date / Editor: 10.08.2020 / MK
' Version Number: 1.0.0.0
Function RemoveDuplicatesFromArray(arrItems)
If (Ubound(arrItems) >= 0) Then
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MSGBOX "Array count: " & (Ubound(arrItems)+1),,"DEBUG - Info: BEFORE deduplication!"
End If
Set objDictionary = CreateObject("Scripting.Dictionary")
For Each strItem in arrItems
If Not objDictionary.Exists(strItem) Then
objDictionary.Add strItem, strItem
End If
Next
intItems = objDictionary.Count - 1
ReDim arrItems(intItems)
i = 0
For Each strKey in objDictionary.Keys
arrItems(i) = strKey
i = i + 1
Next
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MSGBOX "Array count: " & (Ubound(arrItems)+1),,"DEBUG - Info: AFTER deduplication!"
End If
End If
RemoveDuplicatesFromArray = arrItems
End Function

35
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/SendHTTPRequest.vbs Normal file
View File

@@ -0,0 +1,35 @@
' SendHTTPRequest(URL : String)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: SendHTTPRequest : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 10.08.2020 / MK
' Version Date / Editor: 10.08.2020 / MK
' Version Number: 1.0.0.0
Function SendHTTPRequest(URL)
'Create the array for the return values of this function
Dim HTTPRequest(1)
Set Request = CreateObject("MSXML2.XMLHTTP")
Request.Open "POST", URL, False
Request.Send
HTTPRequest(0) = Request.ResponseText
HTTPRequest(1) = Request.Status
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
AddDebugLine "Response from WebServices!"
AddDebugLine "Status: " & HTTPRequest(1)
AddDebugLine "Body: " & HTTPRequest(0)
ShowDebugBox "WebServices"
End If
SendHTTPRequest = HTTPRequest
End Function

24
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/SetLabelText.vbm Normal file
View File

@@ -0,0 +1,24 @@
' SetLabelText(LabelItemID : Short, View: Long, Var: Long, Value: String)
' ----------------------------------------------------------------------------
' Setzt den Text eines Labels im aktuellen Fenster
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.09.2020 / JJ
' Version Date / Editor: 24.02.2021 / MP
' Version Number: 3.0.0.0
Sub SetLabelText(LabelItemID, View, Var, Value)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set labelBox = mywin.Controls.Item(LabelItemID)
CWLCurrentWindow.ActiveWindow.Vars.Value(View, Var) = Value
labelBox.Refresh
End Sub

9
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/SetWinLineDocProductStorage.vbs Normal file
View File

@@ -0,0 +1,9 @@
Sub ShowWinLineDocForEditing
'Version Date 22.09.2020
'Call "Beleg" Window
End Sub

19
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/ShowDebugBox.vbs Normal file
View File

@@ -0,0 +1,19 @@
' ShowDebugBox(Title : String)
' ----------------------------------------------------------------------------
' Zeigt die DEBUG-MsgBox an
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 10.08.2020 / XX
' Version Date / Editor: 10.08.2020 / XX
' Version Number: 1.0.0.0
Sub ShowDebugBox(Title)
MsgBox DEBUG_MESSAGE, vbOkonly, DEBUG_TITLE & " - " & Title
DEBUG_MESSAGE = ""
End Sub

29
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/ShowWinLineDocForEditing.vbs Normal file
View File

@@ -0,0 +1,29 @@
' ShowWinLineDocForEditing
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 22.09.2020 / XX
' Version Date / Editor: 22.09.2020 / XX
' Version Number: 1.0.0.0
Sub ShowWinLineDocForEditing
'Call "Beleg" Window
MChangeGridCell 774, 125, 458753
MGridLeftClick 774, 125, 1, 7
MChangeGridCell 774, 125, 458753
MChangeGridCell 774, 125, 327682
MGridLeftClick 774, 125, 2, 5
MChangeGridCell 774, 125, 458753
MGridLeftClick 774, 125, 1, 7
MPushButton 774, 134, 0
End Sub

46
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/ShowWinLineDocOverview.vbs Normal file
View File

@@ -0,0 +1,46 @@
' ShowWinLineDocOverview(DocNumber : String, AccountNumber : String, RunningNumber : String)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 22.09.2020 / XX
' Version Date / Editor: 22.09.2020 / XX
' Version Number: 1.0.0.0
Sub ShowWinLineDocOverview(DocNumber, AccountNumber, RunningNumber)
'Call "Beleg" Window
MApplication 2
MWindow 774, false
MTreeExpand 774, 102, 321566992, 100
MTreeSelChange 774, 102, 321566992, 1001
MActivateWindow 774
IF (DocNumber <> "") and (AccountNumber <> "") and (RunningNumber <> "") Then
'Set time periode (12 = alle Jahre)
MSetFieldValue 774, 105, "12"
'Set area (1 = Verkauf/Einkauf)
MSetFieldValue 774, 107, "1"
'Set Account number (Kundennummern)
MSetFieldValue 774, 115, AccountNumber
'Set doc number (Belegnummer)
MSetFieldValue 774, 117, DocNumber
'Set Running Nr (Laufnummer)
MSetFieldValue 774, 191, RunningNumber
'Click the ok Button
MPushButton 774, 98, 0
End If
End Sub

35
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/ShowWinLineMandatorAndWinLineYear.vbs Normal file
View File

@@ -0,0 +1,35 @@
' ShowWinLineMandatorAndWinLineYear(WinLineMandatorNr : String, WinLineYear : String)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 22.09.2020 / XX
' Version Date / Editor: 22.09.2020 / XX
' Version Number: 1.0.0.0
Sub ShowWinLineMandatorAndWinLineYear(WinLineMandatorNr, WinLineYear)
'Close all Windows
MPushButton 774, 99, 0
IF (WinLineMandatorNr <> "") and (WinLineYear <> "") Then
Dim Year
Year = (WinLineYear / 12) + 1900
'Close all Windows
'MActivateWindow 85
'MPushButton 85, 99, 0
MActivateWindow 774
MPushButton 774, 99, 0
End If
End Sub

27
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/ShowWinLineProgramMacros.vbs Normal file
View File

@@ -0,0 +1,27 @@
' ShowWinLineProgramMacros
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 23.09.2020 / XX
' Version Date / Editor: 23.09.2020 / XX
' Version Number: 1.0.0.0
Sub ShowWinLineProgramMacros
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
'Return to Macro Window
MApplication 2
MApplication 0
MWindow 45, False
MSetFieldFocus 45, 100
MSetFieldFocus 45, -1
MActivateWindow 45
MSetFieldValue 45, 121, CWLMacro.MName
End If
End Sub

27
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Modules/SwitchWinLineGoToMacros.vbs Normal file
View File

@@ -0,0 +1,27 @@
' SwitchWinLineGoToMacros
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 25.08.2020 / XX
' Version Date / Editor: 25.08.2020 / XX
' Version Number: 1.0.0.0
Sub SwitchWinLineGoToMacros
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
'Return to Macro Window
MApplication 2
MApplication 0
MWindow 45, False
MSetFieldFocus 45, 100
MSetFieldFocus 45, -1
MActivateWindow 45
MSetFieldValue 45, 121, CWLMacro.MName
End If
End Sub

148
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/SQL-Server/FNDD_GET_ALL_MACROSUBARTICLE.sql Normal file
View File

@@ -0,0 +1,148 @@
/****** Object: UserDefinedFunction [dbo].[FNDD_GET_ALL_MACROSUBARTICLE] Script Date: 08.06.2021 13:03:32 ******/
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
-- =================================================================
-- FNDD_GET_ALL_MACROSUBARTICLE
-- =================================================================
-- Die Funktion läd für einen Makro-Artikel alle im VK-Makro enthaltenen
-- Makro-Sub-Artikel inklusive Menge und dem Bundlepreis.
--
-- Die Funktion soll aus einem Web-Shop aufgerufen werden können.
--
-- Returns: Tabelle mit den Spalten
-- LaufendeNummer INT Wert aus t326.c009 Expl: 1
-- MakroSubArtikelnummer VARCHAR(30) Wert aus t326.c006 Expl: 'GT0674001'
-- MakroMenge INT Berechneter Wert aus Aktion, Wert und Expl: 1
-- Bestellter Menge
-- MakroPreis FLOAT Der Bundlepreis für diesen Sub-Artikel Expl: 123.45
--
-- Hinweise:
-- - Wenn der Preis = -999.00 ist, dann wurde kein Bundlepreis gefunden
-- - Wenn die Menge = 0 ist, dann konnte keine menge berchnet werden, z.B. weil es sich um einen Textbaustein handelt!
--
-- =================================================================
-- Copyright (c) 2021 by Digital Data GmbH
--
-- Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
-- Tel.: 0641/202360 • E-Mail: info-flow@digitaldata.works
-- =================================================================
-- Creation Date / Author: 26.05.2021 / MP
-- Version Date / Editor: 27.05.2021 / MP
-- Version Number: 1.0.0.1
-- =================================================================
-- History:
-- 01.01.202X / XX - DESCRIPTION
CREATE FUNCTION [dbo].[FNDD_GET_ALL_MACROSUBARTICLE]
(
-- Add the parameters for the function here
@WinLineYear INT -- Mandatory Parameter, for the WinLine Year (yyyy) Expl: 1440 (= 2020)
,@WinLineMandator VARCHAR(4) -- Mandatory Parameter, for the WinLine Mandator (~~~~) Expl: '500M'
,@MakroArtikelnummer VARCHAR(30) -- Hauptartikelnummer des Makro-Artikels (T026.C003) Expl: 'XX1000001'
,@BestellteMenge INT -- Die bestellte Menge, als Basis für die Anzahl der Sub-Artikel Expl: 1
)
RETURNS @Table TABLE
(
-- Add the column definitions for the TABLE variable here
LaufendeNummer INT
,MakroSubArtikelnummer VARCHAR(30) NOT NULL DEFAULT ''
,MakroMenge INT NOT NULL DEFAULT 0
,MakroPreis FLOAT NOT NULL DEFAULT 0.00
)
AS
BEGIN
DECLARE
@LaufendeNummer INT
,@MakroSubArtikelnummer VARCHAR(30)
,@MakroMenge INT
,@MakroPreis FLOAT
,@MakroWert INT
,@MakroAktion INT
,@VKMakroName VARCHAR(20)
,@LastMengeKonstante INT
SELECT DISTINCT
@VKMakroName = t.c037
FROM v021 t
WHERE t.c002 = @MakroArtikelnummer
AND t.mesocomp = @WinLineMandator
AND t.mesoyear = @WinLineYear
IF Len(@VKMakroName) <= 0
BEGIN
-- Kein VKMakroName definiert, dann gibt es auch keine Sub-Artikel
RETURN
END
DECLARE cursMacroSubArticles CURSOR FOR
SELECT
t.c009 -- Zeile
,t.c006 -- Artikelnummer
,t.c008 -- Wert
,t.c007 -- Aktion
FROM t326 t
WHERE t.c002 like @VKMakroName + '%'
AND t.mesocomp = @WinLineMandator
AND t.mesoyear = @WinLineYear
OPEN cursMacroSubArticles
FETCH NEXT FROM cursMacroSubArticles INTO @LaufendeNummer, @MakroSubArtikelnummer, @MakroWert, @MakroAktion
WHILE @@FETCH_STATUS = 0
BEGIN
-- Hole MakroPreis über die Skalarfunktion FNDD_GET_MACROSUBARTICLE_PRICE
Select @MakroPreis = [dbo].[FNDD_GET_MACROSUBARTICLE_PRICE] (@WinLineYear, @WinLineMandator, @MakroArtikelnummer, @MakroSubArtikelnummer)
-- Berechne die MakroMenge anhand der Aktion, des Wert und der bestellten Menge
IF @MakroAktion = 1
BEGIN
-- Mengeneingabe
SET @MakroMenge = @BestellteMenge
SET @LastMengeKonstante = @BestellteMenge
END
ELSE IF @MakroAktion = 2
BEGIN
-- Mengenkonstante
SET @MakroMenge = @MakroWert
SET @LastMengeKonstante = @MakroWert
END
ELSE IF @MakroAktion = 3
BEGIN
-- Mengenmutliplikation
SET @MakroMenge = @BestellteMenge * @MakroWert
END
ELSE IF @MakroAktion = 4
BEGIN
-- Mengenaddition = Addition des Werts zur letzten Konstante
SET @MakroMenge = @LastMengeKonstante + @MakroWert
END
ELSE
BEGIN
SET @MakroMenge = 0
END
INSERT INTO @Table (
LaufendeNummer
,MakroSubArtikelnummer
,MakroMenge
,MakroPreis
) VALUES (
@LaufendeNummer
,@MakroSubArtikelnummer
,@MakroMenge
,@MakroPreis
)
FETCH NEXT FROM cursMacroSubArticles INTO @LaufendeNummer, @MakroSubArtikelnummer, @MakroWert, @MakroAktion
END
CLOSE cursMacroSubArticles
DEALLOCATE cursMacroSubArticles
RETURN
END
GO

78
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/SQL-Server/FNDD_GET_MACROSUBARTICLE_PRICE.sql Normal file
View File

@@ -0,0 +1,78 @@
/****** Object: UserDefinedFunction [dbo].[FNDD_GET_MACROSUBARTICLE_PRICE] Script Date: 08.06.2021 13:04:22 ******/
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
-- FNDD_GET_MACROSUBARTICLE_PRICE
-- =================================================================
-- Die Funktion ermittelt für Makro-Sub-Artikel den Bundlepreis für
-- einen definierten Makro-Artikel.
-- Voraussetzung ist, dass es eine "Bundlepreisliste" gibt, und dass
-- es für diese Preisliste und den Makroartikel einen speziellen Preis
-- gibt.
-- Wurde kein solcher Preis gefunden, gibt die Funktion -999 zurück.
--
-- Returns: Bundlepreis : FLOAT
-- =================================================================
-- Copyright (c) 2021 by Digital Data GmbH
--
-- Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
-- Tel.: 0641/202360 • E-Mail: info-flow@digitaldata.works
-- =================================================================
-- Creation Date / Author: 26.05.2021 / MP
-- Version Date / Editor: 08.06.2021 / MP
-- Version Number: 1.0.0.1
-- =================================================================
-- History:
-- 08.06.2021 / MP - Bundlepreisliste aus dem Mandantenstamm ziehen
CREATE FUNCTION [dbo].[FNDD_GET_MACROSUBARTICLE_PRICE]
(
-- Parameters for this function
@WinLineYear INT -- Mandatory Parameter, for the WinLine Year (yyyy) Expl: 1440 (= 2020)
,@WinLineMandator VARCHAR(4) -- Mandatory Parameter, for the WinLine Mandator (~~~~) Expl: '500M'
,@MakroArtikelnummer VARCHAR(30) -- Hauptartikelnummer des Makro-Artikels (T026.C003) Expl: 'XX1000001'
,@MakroSubArtikelnummer VARCHAR(30) -- Hauptartikelnummer (T026.C003) Expl: 'AC0101001'
)
RETURNS VARCHAR(256)
AS
BEGIN
-- Declare the return variable here
DECLARE
@RESULT FLOAT = -999
,@T044_PREISLISTENR INT
,@T043_PREIS FLOAT
-- 1. Finde die Nummer der Bundlepreisliste in den Zusatzfeldern im Mandantenstamm
SELECT TOP 1
@T044_PREISLISTENR = t.c014
FROM t057 t
WHERE t.c031 = '001' -- Zusatzfelder aus dem Mandantenstamm
AND t.mesocomp = @WinLineMandator
AND t.mesoyear = @WinLineYear
-- 2. Finde einen Preis in der Preisliste für den Artikel (t043)
IF (@T044_PREISLISTENR > 0)
BEGIN
SELECT TOP 1
@RESULT = t.c013
FROM T043 t WITH(NOLOCK)
WHERE t.c000 = @MakroSubArtikelnummer
AND t.c002 = @T044_PREISLISTENR
AND t.c014 LIKE @MakroArtikelnummer
AND t.mesocomp = @WinLineMandator
AND t.mesoyear = @WinLineYear
END
-- Failsafe
SET @RESULT = ISNULL(@RESULT, -999)
RETURN @RESULT
END
GO

19
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/SQL-Server/IM_Beleg_PacktischLieferschein_VK_Kopf.sql Normal file
View File

@@ -0,0 +1,19 @@
/****** Object: Table [dbo].[IM_Beleg_PacktischLieferschein_VK_Kopf] Script Date: 17.06.2021 14:03:08 ******/
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
CREATE TABLE [dbo].[IM_Beleg_PacktischLieferschein_VK_Kopf](
[BELEGKEY] [int] NULL,
[Kontonummer] [nvarchar](20) NULL,
[Laufnummer] [nvarchar](20) NULL,
[Auftragsnummer] [nvarchar](20) NULL,
[Belegdatum] [datetime] NULL,
[ts] [timestamp] NULL
) ON [PRIMARY]
GO

28
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/SQL-Server/IM_Beleg_PacktischLieferschein_VK_Mitte.sql Normal file
View File

@@ -0,0 +1,28 @@
/****** Object: Table [dbo].[IM_Beleg_PacktischLieferschein_VK_Mitte] Script Date: 17.06.2021 14:03:57 ******/
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
CREATE TABLE [dbo].[IM_Beleg_PacktischLieferschein_VK_Mitte](
[BELEGKEY] [int] NULL,
[Artikelnummer] [nvarchar](30) NULL,
[Hauptartikelnummer] [nvarchar](30) NULL,
[Zeilennummer] [int] NULL,
[Datentyp] [nvarchar](1) NULL,
[Mengegeliefert] [float] NULL,
[ChargeIdentnummer] [nvarchar](30) NULL,
[Auspr1] [nvarchar](30) NULL,
[Auspr2] [nvarchar](30) NULL,
[Lagerort] [int] NULL,
[ts] [timestamp] NULL,
[Einzelpreis] [float] NULL
) ON [PRIMARY]
GO
ALTER TABLE [dbo].[IM_Beleg_PacktischLieferschein_VK_Mitte] ADD CONSTRAINT [DF_IM_Beleg_PacktischLieferschein_VK_Mitte_Einzelpreis] DEFAULT ((0.00)) FOR [Einzelpreis]
GO

BIN
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/Thumbs.db Normal file
View File

Binary file not shown.

BIN
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/WinLine MDP/Packtisch-Fenster.mdp Normal file
View File

Binary file not shown.

BIN
archive/Packtisch Modul/Packtisch 3.0.0.3 - Setup/WinLine MDP/Packtisch-SQL.mdp Normal file
View File

Binary file not shown.

BIN
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Dokumentation/EXIM-Packtisch.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 68 KiB

37
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Dokumentation/Features - Packtisch 3.0.0.4.txt Normal file
View File

@@ -0,0 +1,37 @@
Packtisch 3.0.0.4
Features und Korrekturen
========================
- Anpassungen wegen Handbuch-Erstellung und Installationsanleitung
-> Neuer Abschnitt # Set Customizable Constants # in Makro und Fensterskript
-> U-Felder der Tabelle T025 sind jetzt optional und konfigurierbar
-> Artikelgruppengrenze für nicht-relevante Artikel ist konfigurierbar
-> Zusatzfelder (Mandanten- / Artikelstamm) sind jetzt konfigurierbar
- Korrektur für Teillieferungen bei Spät-Ausprägungen
-> Es wird sichergestellt, dass alle Positionen in Tabelle "IM_Beleg_PacktischLieferschein_VK_Mitte" (EXIM_MEDACOM)
enthalten sind, um Teil- und Restlieferungen vollständig bearbeiten zu können.
Umfang
======
- Fensterskript PACKTISCH_3_0
- Makro CONVERT-WINLINE_DOCUMENT_ORDER_TO_DELIVERYN
- geänderte Modul-Skripte
- Packtisch_3_0\ArticleExists.vbm
- Packtisch_3_0\CompleteOrder.vbm
- Packtisch_3_0\LoadOrder.vbm
- Packtisch_3_0\TestArticleHasSerialNumberRegex.vbm
- Packtisch_3_0\UpdateDeliveryNote.vbm
- Packtisch_3_0\UpdateOrderDataBeforeDelNote.vbm
- neue Modul-Skripte
- Packtisch_3_0\CheckArticleGroupIsRelevant.vbm

BIN
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Dokumentation/Thumbs.db Normal file
View File

Binary file not shown.

18
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/AddDebugLine.vbs Normal file
View File

@@ -0,0 +1,18 @@
' AddDebugLine(Message: String)
' ----------------------------------------------------------------------------
' Fügt der DEBUG_MESSAGE eine neue Zeile hinzu
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 20.08.2020 / XX
' Version Date / Editor: 20.08.2020 / XX
' Version Number: 1.0.0.0
Sub AddDebugLine(Message)
DEBUG_MESSAGE = DEBUG_MESSAGE & Message & vbNewLine
End Sub

19
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/AddTwoDimArrayRow.vbm Normal file
View File

@@ -0,0 +1,19 @@
' AddTwoDimArrayRow(arr: Array)
' ----------------------------------------------------------------------------
' Fügt an ein zweidimensionales Array eine Zeile an.
' Wichtig: Die Spalten müssen die erste Dimension sein!
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 18.02.2021 / JJ
' Version Date / Editor: 18.02.2021 / JJ
' Version Number: 3.0.0.0
Sub AddTwoDimArrayRow(Byref arr)
ReDim Preserve arr(UBound(arr, 1), UBound(arr, 2) + 1)
End Sub

49
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/ConvertFromSecureString.vbs Normal file
View File

@@ -0,0 +1,49 @@
' ConvertFromSecureString(Ciphertext : String)
' ----------------------------------------------------------------------------
' Gibt den entschlüsselten String zurück
'
' Source: https://gist.github.com/albert1205/c8430b5bfa505f9308e4fa789b9b1d7f
'
' Returns: ConvertFromSecureString : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 26.08.2020 / XX
' Version Date / Editor: 26.08.2020 / XX
' Version Number: 1.0.0.0
Public Function ConvertFromSecureString(Ciphertext)
Const offset = 10
Const minAsc = 33
Const maxAsc = 126
If Len(Ciphertext) < 5 Then
Decrypt = ""
Exit Function
End If
Dim Plaintext
Ciphertext = Mid(Ciphertext,3,Len(Ciphertext)-4)
For i=2 To Len(Ciphertext) Step 2
oldAsc = Asc(Mid(Ciphertext,i,1)) + offset
If oldAsc > maxAsc Then
oldAsc = oldAsc - maxAsc + minAsc - 1
End If
Plaintext = Plaintext & Chr(oldAsc)
' MsgBox Asc(Mid(Ciphertext,i,1)) & " -> " & oldAsc
Next
ConvertFromSecureString = Plaintext
End Function
Private Sub DecryptTool()
Ciphertext = InputBox("Bitte den zu entschluesselnden String eingeben:", "Eingabe erfolderlich","")
Plaintext = ConvertFromSecureString(Ciphertext)
InputBox "Ihre Eingabe lautete: " & Ciphertext & vbNewLine & vbNewLine & "Entschluesselt, sieht der String wie folgt aus:","Erledigt!",Plaintext
End Sub

55
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/ConvertToSecureString.vbs Normal file
View File

@@ -0,0 +1,55 @@
' ConvertToSecureString(Plaintext : String)
' ----------------------------------------------------------------------------
' Verschlüsselt einen String
'
' Source: https://gist.github.com/albert1205/c8430b5bfa505f9308e4fa789b9b1d7f
'
' Returns: ConvertToSecureString : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 26.08.2020 / XX
' Version Date / Editor: 26.08.2020 / XX
' Version Number: 1.0.0.0
Public Function ConvertToSecureString(Plaintext)
Const offset = 10
Const minAsc = 33
Const maxAsc = 126
Dim Ciphertext
Randomize
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
For i=1 To Len(Plaintext)*2
If i mod 2 = 0 Then
newAsc = Asc(Mid(Plaintext,i/2,1)) - offset
If newAsc < minAsc Then
newAsc = newAsc + maxAsc - minAsc + 1
End If
Ciphertext = Ciphertext & Chr(newAsc)
' MsgBox Asc(Mid(Plaintext,i/2,1)) & " -> " & newAsc
Else
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
' MsgBox "Rnd:" & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
End If
Next
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
ConvertToSecureString = Ciphertext
End Function
Private Sub EncryptTool()
Plaintext = InputBox("Bitte den zu verschluesselnden String eingeben:","Eingabe erfolderlich","")
Ciphertext = ConvertToSecureString(Plaintext)
InputBox "Ihre Eingabe lautete: " & Plaintext & vbNewLine & vbNewLine & "Verschluesselt, sieht der String wie folgt aus:","Erledigt!",Ciphertext
End Sub
Call EncryptTool

18
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/GetLeftPad.vbs Normal file
View File

@@ -0,0 +1,18 @@
' GetLeftPad(Value)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: GetLeftPad : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 10.08.2020 / MK
' Version Date / Editor: 10.08.2020 / MK
' Version Number: 1.0.0.0
Function GetLeftPad(Value)
GetLeftPad = Right("0" & Value, 2)
End Function

83
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/GetWinLineDocDeliveryNoteByUnsplittedProducts.vbs Normal file
View File

@@ -0,0 +1,83 @@
' GetWinLineDocDeliveryNoteByUnsplittedProducts(ProductNumber : String, WinLineMandatorNr : String, WinLineYear : Int)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: NAME : TYP
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 15.09.2020 / JJ
' Version Date / Editor: 15.09.2020 / JJ
' Version Number: 1.0.0.0
Function GetWinLineDocDeliveryNoteByUnsplittedProducts(ProductNumber, WinLineMandatorNr, WinLineYear)
Dim Conn, Result
Set Conn = CWLStart.CurrentCompany.Connection
If (ProductNumber <> "") and (WinLineMandatorNr <> "") and (WinLineYear <> "") Then
'c999 = cOrdnerNr
'c998 = cInvoiceNr
'c997 = KeyValue
'c996 = KeyValue
'MESOPRIM = MESOPRIM
'c995 = Amount / Pos
'c994 = Amount / overall
SQL = ""
SQL = SQL & "SELECT t025.c045 as [c999], t025.c055 as [c998], T026.C000 as [c997], T025.C000 as [c996], T024.MESOPRIM, t026.c006 as [c995], "
SQL = SQL & "( "
SQL = SQL & "SELECT sum(t026.c006) "
SQL = SQL & "FROM T026 WITH (NOLOCK), T025 WITH (NOLOCK), T024 WITH (NOLOCK) "
SQL = SQL & "WHERE T026.MESOCOMP = '"& WinLineMandatorNr &"' AND T025.MESOCOMP = '"& WinLineMandatorNr &"' AND T024.MESOYEAR = '"& WinLineCurrentYear &"' AND T024.MESOCOMP = '"& WinLineMandatorNr &"' "
SQL = SQL & "AND (T025.C021 = T026.C044 AND T025.C022 = T026.C045 AND T025.C137 = 3 AND T026.C042 = N'1' AND T026.C055 < 10 AND T026.C074 < 10 AND T025.C186 = 0 AND T026.C003 = T024.C002 "
SQL = SQL & "AND (T025.C025 = N'D' OR T025.C025 =N'*' OR T025.C026 = N'D' OR T025.C026 =N'*') "
SQL = SQL & "AND (T026.C039 = N'D' OR T026.C039 =N'*' OR T026.C040 = N'D' OR T026.C040 =N'*') "
SQL = SQL & "AND T026.C006 <> 0.0 AND T026.C109 <= 0 AND T026.C003 >= '"& ProductNumber &"' AND T026.C003 <= N'TT1111001') "
SQL = SQL & ") as [c994] "
SQL = SQL & "FROM T026 WITH (NOLOCK), T025 WITH (NOLOCK), T024 WITH (NOLOCK) "
SQL = SQL & "WHERE T026.MESOCOMP = '"& WinLineMandatorNr &"' AND T025.MESOCOMP = '"& WinLineMandatorNr &"' AND T024.MESOYEAR = '"& WinLineCurrentYear &"' AND T024.MESOCOMP = '"& WinLineMandatorNr &"' "
SQL = SQL & "AND (T025.C021 = T026.C044 AND T025.C022 = T026.C045 AND T025.C137 = 3 AND T026.C042 = N'1' AND T026.C055 < 10 AND T026.C074 < 10 AND T025.C186 = 0 AND T026.C003 = T024.C002 "
SQL = SQL & "AND (T025.C025 = N'D' OR T025.C025 =N'*' OR T025.C026 = N'D' OR T025.C026 =N'*') "
SQL = SQL & "AND (T026.C039 = N'D' OR T026.C039 =N'*' OR T026.C040 = N'D' OR T026.C040 =N'*') "
SQL = SQL & "AND T026.C006 <> 0.0 AND T026.C109 <= 0 AND T026.C003 >= '"& ProductNumber &"' AND T026.C003 <= '"& ProductNumber &"' ) "
SQL = SQL & "ORDER BY T026.C003 ASC, T026.C025, T026.C044, T026.C045 "
'MsgBox "SQL (Part 1): " & Mid(SQL, 1, 750)
'MsgBox "SQL (Part 2): " & Mid(SQL, 750)
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for unsplitted delivery notes.. " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL (Part 1): " & Mid(SQL, 1, 750)
AddDebugLine "SQL (Part 2): " & Mid(SQL, 750)
ShowDebugBox "GetWinLineInternalProductNumber"
End If
'Use the set order, because we want to return an object!
Set GetWinLineDocDeliveryNoteByUnsplittedProducts = Result
Else
If DEBUG_ON = True Then
AddDebugLine "Invalid argument call!" & vbNewline
ShowDebugBox "GetWinLineInternalProductNumber"
End If
GetWinLineDocDeliveryNoteByUnsplittedProducts = 0
End If
End Function

281
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/GetWinLineDocInfoByAccountAndRunningNr.vbs Normal file
View File

@@ -0,0 +1,281 @@
' GetWinLineDocInfoByAccountAndRunningNr(DocAccountAndRunningNr : String, PostingType : String, WinLineDocType : String)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: GetWinLineDocInfoByAccountAndRunningNr : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 08.01.2021 / XX
' Version Date / Editor: 08.01.2021 / XX
' Version Number: 1.0.0.0
Function GetWinLineDocInfoByAccountAndRunningNr(DocAccountAndRunningNr, PostingType, WinLineDocType)
On Error Resume Next
'Set SQL Table and Query for DocHead. Default: "T025"
SQLTable_DocHead = "[T025]"
SQLQuery_DocHead = "c000 = '" & DocAccountAndRunningNr & "'" & SQLQuery_OrderWhere
'Set SQL Table and Query for DocMid. Default: "T026"
SQLTable_DocMid = "[T026]"
SQLQuery_DocMid_MengeGeliefert = ""
SQLQuery_DocMid_MengeGeliefert = SQLQuery_DocMid_MengeGeliefert & "SELECT SUM(c006) as [MengeGeliefert] "
SQLQuery_DocMid_MengeGeliefert = SQLQuery_DocMid_MengeGeliefert & "FROM " & SQLTable_DocMid & "(NOLOCK) "
SQLQuery_DocMid_MengeGeliefert = SQLQuery_DocMid_MengeGeliefert & "WHERE [c000] LIKE '" & DocAccountAndRunningNr & "-%'" & SQLQuery_OrderWhere
SQLQuery_DocMid_Rueckstandsmenge = ""
SQLQuery_DocMid_Rueckstandsmenge = SQLQuery_DocMid_Rueckstandsmenge & "SELECT SUM(c099) as [RueckstandsMenge] "
SQLQuery_DocMid_Rueckstandsmenge = SQLQuery_DocMid_Rueckstandsmenge & "FROM " & SQLTable_DocMid & "(NOLOCK) "
SQLQuery_DocMid_Rueckstandsmenge = SQLQuery_DocMid_Rueckstandsmenge & "WHERE [c000] LIKE '" & DocAccountAndRunningNr & "-%'" & SQLQuery_OrderWhere
IF (SQLTable_DocHead <> "") and (SQLQuery_DocHead <> "") and (PostingType <> "") and (WinLineDocType <> "") Then
Set SQLResult_DocHead = CWLStart.CurrentCompany.SearchRecord (SQLTable_DocHead, SQLQuery_DocHead)
If Err.Number <> 0 Then
MSGBOX "Error Code: "& Err.Number & vbCrlf & _
"Error Description: "& Err.Description,,"ERROR: Function GetWinLineDocInfoByAccountAndRunningNr Getting DocHead from DB Table "& SQLTable_DocHead
Err.Clear
Else
'If no line results
If SQLResult_DocHead.RowCount = -1 Then
If DebugMode = "Enabled" Then
MSGBOX "No Rows found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table "& SQLTable_DocHead
End If
Elseif SQLResult_DocHead.RowCount = 1 Then
If DebugMode = "Enabled" Then
MSGBOX "One Row found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table "& SQLTable_DocHead
End If
'Unique Key
DocAccountAndRunningNr = SQLResult_DocHead.value(0)
'Laufnumemr
DocRunningNr = SQLResult_DocHead.value(21)
'Druckstatus Angebot / Anfrage
DocPrintState1 = SQLResult_DocHead.value(22)
'Druckstatus Auftrag / Bestellung
DocPrintState2 = SQLResult_DocHead.value(23)
'Druckstatus Lieferschein
DocPrintState3 = SQLResult_DocHead.value(24)
'Druckstatus Rechnung
DocPrintState4 = SQLResult_DocHead.value(25)
'Number of the Offer ("Angebot")
DocOfferNr = SQLResult_DocHead.value(41)
'Number of the Order ("Angebot")
DocOrderNr = SQLResult_DocHead.value(42)
'Number of delivery note ("Lieferschein")
DocDeliveryNoteNr = SQLResult_DocHead.value(43)
'Number of the Invoice ("Rechung")
DocInvoiceNr = SQLResult_DocHead.value(52)
'When the doc ("Beleg") was created
DocCreated = SQLResult_DocHead.value(56)
'When the doc ("Beleg") was last changed
DocLastChange = SQLResult_DocHead.value(57)
'The ten "Belegkopfnotizen"
DocHeadText1 = SQLResult_DocHead.value(59)
DocHeadText2 = SQLResult_DocHead.value(60)
DocHeadText3 = SQLResult_DocHead.value(61)
DocHeadText4 = SQLResult_DocHead.value(62)
DocHeadText5 = SQLResult_DocHead.value(63)
DocHeadText6 = SQLResult_DocHead.value(64)
DocHeadText7 = SQLResult_DocHead.value(65)
DocHeadText8 = SQLResult_DocHead.value(66)
DocHeadText9 = SQLResult_DocHead.value(67)
DocHeadText10 = SQLResult_DocHead.value(68)
'The current type (1= Anfrage/Angebot; 2= Auftrag/Bestellung; 3= Lieferschein; 4=Rechnung)
DocType = SQLResult_DocHead.value(134)
DocComment = SQLResult_DocHead.value(163)
'msgbox SQLQuery_DocMid_MengeGeliefert
'msgbox SQLQuery_DocMid_RueckstandsMenge
Set SQLResult_DocMid_MengeGeliefert = CWLStart.CurrentCompany.Connection.Select(SQLQuery_DocMid_MengeGeliefert)
'msgbox SQLResult_DocMid_MengeGeliefert.value("MengeGeliefert")
Set SQLResult_DocMid_RueckstandsMenge = CWLStart.CurrentCompany.Connection.Select(SQLQuery_DocMid_RueckstandsMenge)
'msgbox SQLResult_DocMid_RueckstandsMenge.value("RueckstandsMenge")
IF DebugMode = "Enabled" THEN
End if
DocBackOrder = SQLResult_DocMid_RueckstandsMenge.value("RueckstandsMenge")
'msgbox SQLResult_DocMid_Rueckstandsmenge.value("RueckstandsMenge")
IF (PostingType = 1) Then
'If doc = "Angebot" or "Angebots-storno"
IF (WinLineDocType = 1) or (WinLineDocType = 11) then
DocNr = DocOfferNr
IF (WinLineDocType = 1) then
WinLineDocType = "Angebot (debitorisch)"
ElseIF (WinLineDocType = 11) then
WinLineDocType = "Angebot-Storno (debitorisch)"
End If
'If doc = "Auftrag" or "Auftrag-storno"
ElseIf (WinLineDocType = 2) or (WinLineDocType = 12) then
DocNr = DocOrderNr
IF (WinLineDocType = 2) then
WinLineDocType = "Auftrag (debitorisch)"
ElseIF (WinLineDocType = 12) then
WinLineDocType = "Auftrag-Storno (debitorisch)"
End If
'If doc = "Lieferschein" or "Lieferschein-storno" or "Teillieferschein"
ElseIf (WinLineDocType = 3) or (WinLineDocType = 13) or (WinLineDocType = -3) then
DocNr = DocDeliveryNoteNr
IF (DocBackOrder = 0) and (DocPrintState3 <> "L") then
WinLineDocType = "Lieferschein (debitorisch)"
ElseIF (DocBackOrder = 0) and (DocPrintState3 = "L") then
WinLineDocType = "Lieferschein-Storno (debitorisch)"
ElseIF (DocBackOrder <> 0) and (DocPrintState3 <> "L") then
WinLineDocType = "Teillieferschein (debitorisch)"
ElseIF (DocBackOrder <> 0) and (DocPrintState3 = "L") then
'Über die DB Werte ist eine Unterscheidung zwischen Lieferschein und Teillieferschein Storno nicht möglich!
WinLineDocType = "Teillieferschein-Storno (debitorisch)"
End If
'If doc = "Rechnung" or "Rechnungs-storno"
ElseIf (WinLineDocType = 4) or (WinLineDocType = 14) then
DocNr = DocInvoiceNr
IF (WinLineDocType = 4) and (DocPrintState4 <> "L") then
WinLineDocType = "Rechnung (debitorisch)"
ElseIF (WinLineDocType = 4) and (DocPrintState4 = "L") then
WinLineDocType = "Rechnung-Storno (debitorisch)"
ElseIF (WinLineDocType = 14) and (DocPrintState4 = "L") then
WinLineDocType = "Rechnung-Storno (debitorisch)"
End If
Else
IF DebugMode = "Enabled" THEN
MSGBOX "WinLineDocType is not configured!" & vbCrLf & _
"WinLineDocType: " & WinLineDocType, , "DEBUG - Info: Export Metadata"
END IF
End if
ElseIf (PostingType = 2) Then
'not implement
End if
'Array for the function to return
DIM DocInfo(250)
'Items like T25 c000 to c188
DocInfo(59) = DocCreated
DocInfo(60) = DocLastChange
DocInfo(63) = DocHeadText1
DocInfo(64) = DocHeadText2
DocInfo(65) = DocHeadText3
DocInfo(66) = DocHeadText4
DocInfo(67) = DocHeadText5
DocInfo(68) = DocHeadText6
DocInfo(69) = DocHeadText7
DocInfo(70) = DocHeadText8
DocInfo(71) = DocHeadText9
DocInfo(72) = DocHeadText10
DocInfo(139) = DocType
DocInfo(165) = DocComment
'Items beyond T25
DocInfo(200) = WinLineDocType
DocInfo(201) = DocNr
IF DebugMode = "Enabled" THEN
CRLF = chr(13)&chr(10)
msg = "Parameter:" & CRLF
For i = 0 To Ubound(DocInfo)
If (DocInfo(i) <> "") then
msg = msg & i & ".: " & DocInfo(i) & CRLF
end if
Next
msgbox msg ,, "Macro Name: " & CWLMacro.MName
End if
GetWinLineDocInfoByAccountAndRunningNr = DocInfo
Else
If DebugMode = "Enabled" Then
MSGBOX "To many Rows found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNr DocHead from Database table "& SQLTable_DocHead
End If
GetWinLineDocInfoByAccountAndRunningNr = ""
End If
End If
Else
If DebugMode = "Enabled" Then
MSGBOX "Missing Parameter values, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table " & SQLTable_DocHead
End If
GetWinLineDocInfoByAccountAndRunningNr = ""
End If
End Function

103
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/GetWinLineDocUniqueByNumber.vbs Normal file
View File

@@ -0,0 +1,103 @@
' GetWinLineDocUniqueIdentifier(GetWinLineDocUniqueIdentifierParams)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: NAME : TYP
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.12.2020 / MK
' Version Date / Editor: 01.12.2020 / MK
' Version Number: 1.0.0.0
Function GetWinLineDocUniqueIdentifier(GetWinLineDocUniqueIdentifierParams)
'SYNOPSIS
'Function will load external - additional - VBS Modules into current Script.
'DESCRIPTION
'By working with Modules, this Function is necessary to load external Module Functions into the current VB-Script.
'Call parameter must be an array, because VB-Script functions cannot handle optional Parameters.
'In develepment and Test Enviroment it is possible, to work with distributed Folders with different Modules. Therefor the Parameter
'"GetWinLineDocUniqueIdentifierParams(1)" (which is the ModuleOverrideSourcePath) and the preset Variable "ModuleDefaultSourcePath" are made for.
'After a successful Import of a Module, Function will return True, otherwise a False.
'REQUIREMENT General
'VBS must be enabled
'REQUIREMENT Assembly
'<NONE>
'REQUIREMENT Variables
'FSOModule, Module, ModuleCode
'REQUIREMENT Variables preSet
'<NONE>
'REQUIREMENT Functions
'<NONE>
'VERSION
'Number: 1.0.0.0 / Date: 01.12.2020
'PARAMETER GetWinLineDocUniqueIdentifierParams(0) = WorkingMode
'Give the
'PARAMETER GetWinLineDocUniqueIdentifierParams(1) = DocAccountAndRunningNr
'Optional Parameter.
'PARAMETER GetWinLineDocUniqueIdentifierParams(2) = DocAccountNr
'Optional Parameter.
'PARAMETER GetWinLineDocUniqueIdentifierParams(3) = DocRunningNr
'Optional Parameter.
'EXAMPLE
'Dim GetWinLineDocUniqueIdentifierParams
'Redim GetWinLineDocUniqueIdentifierParams(0)
'GetWinLineDocUniqueIdentifierParams(0) = Module
'LoadVBSModule(GetWinLineDocUniqueIdentifierParams)
'EXAMPLE
'Dim GetWinLineDocUniqueIdentifierParams
'Redim GetWinLineDocUniqueIdentifierParams(1)
'GetWinLineDocUniqueIdentifierParams(0) = Module
'GetWinLineDocUniqueIdentifierParams(1) = "D:\ScriptFiles\Modules"
'LoadVBSModule(GetWinLineDocUniqueIdentifierParams)
On Error Resume Next
If VarType(GetWinLineDocUniqueIdentifierParams) > 8000 Then
WorkingMode = GetWinLineDocUniqueIdentifierParams(0)
DocAccountAndRunningNr = GetWinLineDocUniqueIdentifierParams(1)
DocAccountNr = GetWinLineDocUniqueIdentifierParams(2)
DocRunningNr = GetWinLineDocUniqueIdentifierParams(3)
IF (WorkingMode = "interactive") or (WorkingMode = "interaktive") Then
GetWinLineDocUniqueIdentifier = DocAccountAndRunningNr
Else
GetWinLineDocUniqueIdentifier = DocAccountAndRunningNr
End If
'If no array was used by calling this function
Else
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MSGBOX "The used Parameter is not an Array!" & vbCrlf & _
"",,"DEBUG Info: Parameter is not an Array - GetWinLineDocUniqueIdentifierParams"
End If
GetWinLineDocUniqueIdentifier = ""
End if
End Function 'GetWinLineDocUniqueIdentifier

49
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/GetWinLineInternalProductNumber.vbs Normal file
View File

@@ -0,0 +1,49 @@
' GetWinLineInternalProductNumber(ProductNumber : String, SerialNumber : String)
' ----------------------------------------------------------------------------
' Holt die interne ProductNumber (c002) aus der Artikelview, wenn es eine
' Seriennummer gibt, ansonsten passt der Wert aus dem Parameter
'
' Returns: Interne Artikelnummer
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 10.08.2020 / MK
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
Function GetWinLineInternalProductNumber(ProductNumber, SerialNumber)
Set Conn = CWLStart.CurrentCompany.Connection
Err.Clear
If SerialNumber = "" Then
GetWinLineInternalProductNumber = ProductNumber
Else
SQL = "SELECT [c002] FROM [v021] (NOLOCK) WHERE [c011] = '"& ProductNumber &"' AND [c068] = '"& SerialNumber &"' AND (c038 IS NULL) " & SQLQuery_BasicWhere
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for Internal Article Number.. " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineInternalProductNumber"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetWinLineInternalProductNumber"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - GetWinLineInternalProductNumber"
Exit Function
End If
End If
GetWinLineInternalProductNumber = Result.Value("c002")
End If
End Function

60
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/GetWinLineOriginalLineNumber.vbs Normal file
View File

@@ -0,0 +1,60 @@
' GetWinLineOriginalLineNumber(OrderNumber : String, ArticleNumber : String, IsSerialNumberArticle : Int)
' ----------------------------------------------------------------------------
' Ermittelt die originale Zeilennummer einer belegposition
'
' 18.02.21 - Wird im Packtisch 3.0 nicht mehr verwendet
'
' Returns: GetWinLineOriginalLineNumber : Int
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 18.08.2020 / MK
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
Function GetWinLineOriginalLineNumber(OrderNumber, ArticleNumber, IsSerialNumberArticle)
Set Conn = CWLStart.CurrentCompany.Connection
Err.Clear
If IsSerialNumberArticle = 1 Then
SQL = "SELECT TOP 1 c078 FROM t026 (NOLOCK) "
SQL = SQL & "WHERE c067 = '"& OrderNumber &"' AND c003 = '"& ArticleNumber &"' "
SQL = SQL & SQLQuery_OrderWhere
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for Original Line Number.. " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineOriginalLineNumber"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetWinLineOriginalLineNumber"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - GetWinLineOriginalLineNumber"
Exit Function
End If
End If
GetWinLineOriginalLineNumber = Result.Value("c078")
Else
If DEBUG_ON = True Then
AddDebugLine "Setting Original Line Number to 0.."
ShowDebugBox "GetWinLineOriginalLineNumber"
End If
GetWinLineOriginalLineNumber = "0"
End If
End Function

48
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/GetWinLineProductInfoByProductNumber.vbs Normal file
View File

@@ -0,0 +1,48 @@
' GetWinLineProductInfoByProductNumber(ProductNumber : String, WinLineMandatorNr : String, WinLineYear : Int)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: NAME : TYP
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 23.09.2020 / JJ
' Version Date / Editor: 23.09.2020 / JJ
' Version Number: 1.0.0.0
Function GetWinLineProductInfoByProductNumber(ProductNumber, WinLineMandatorNr, WinLineYear)
On Error Resume Next
If (ProductNumber <> "") Then
SQLTable_WinLineProductInfo = "V021"
SQLQuery_WinLineProductInfo = "c011 = '"& ProductNumber &"' and c002 = c011 and MESOCOMP = '"& WinLineMandatorNr &"' AND MESOYEAR = '"& WinLineCurrentYear &"'"
Set SQLResult_WinLineProductInfo = CWLStart.CurrentCompany.SearchRecord (SQLTable_WinLineProductInfo, SQLQuery_WinLineProductInfo)
If (DEBUG_ON = True) or (DebugMode = "Enabled" ) Then
AddDebugLine "Querying for Article Number.. " & vbNewline
AddDebugLine "Result Columns: " & SQLResult_WinLineProductInfo
AddDebugLine "Result Rows: " & SQLResult_WinLineProductInfo.RowCount
AddDebugLine "SQL: " & SQLQuery_WinLineProductInfo
ShowDebugBox "GetWinLineInternalProductNumber"
End If
If (SQLResult_WinLineProductInfo.RowCount = -1) or (SQLResult_WinLineProductInfo.RowCount = 0) Then
GetWinLineProductInfoByProductNumber = 0
Elseif (SQLResult_WinLineProductInfo.RowCount >= 1) Then
Set GetWinLineProductInfoByProductNumber = SQLResult_WinLineProductInfo
End if
End if
End Function

37
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/GetWinLineStockedAmount.vbs Normal file
View File

@@ -0,0 +1,37 @@
' GetWinLineStockedAmount(ProductNumber : String, IncludeSalesDocuments : Boolean)
' ----------------------------------------------------------------------------
' Lagerstand des Artikels prüfen
'
' Returns: NAME : TYP
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 22.01.2021 / XX
' Version Date / Editor: 22.01.2021 / XX
' Version Number: 1.0.0.0
Function GetWinLineStockedAmount(ProductNumber, IncludeSalesDocuments)
SQL = ""
SQL = SQL & "SELECT "
SQL = SQL & "(SELECT C008 AS [MengeZugang] from [v021] (NOLOCK) where (c002 = '__ARTICLENUMBER__') "& SQLQuery_BasicWhere &") - "
SQL = SQL & "(SELECT C009 AS [MengeAbgang] from [v021] (NOLOCK) where (c002 = '__ARTICLENUMBER__') "& SQLQuery_BasicWhere &") - "
If IncludeSalesDocuments = True Or IncludeSalesDocuments = "True" Or IncludeSalesDocuments = 1 Then
' Include Products from sales documents
SQL = SQL & "ISNULL((SELECT SUM(C035) AS [MengeVerkauf] FROM [t014] (NOLOCK) where c000 = '__ARTICLENUMBER__' "& SQLQuery_BasicWhere &"), 0) "
Else
' Skip Products from sales documents
SQL = SQL & "(SELECT 0) "
End If
SQL = SQL & "AS c000"
SQL = Replace(SQL, "__ARTICLENUMBER__", ProductNumber)
Set Result = CWLStart.CurrentCompany.Connection.Select(SQL)
GetWinLineStockedAmount = Result.Value("c000")
End Function

75
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/GetWinLineStorageLocation.vbs Normal file
View File

@@ -0,0 +1,75 @@
' GetWinLineStorageLocation(ProductNumber : String, ProductSerialNumber : String, IsSerialNumberArticle : Int)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: GetWinLineStorageLocation : Int
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 07.01.2021 / XX
' Version Date / Editor: 07.01.2021 / XX
' Version Number: 1.0.0.0
Function GetWinLineStorageLocation(ProductNumber, ProductSerialNumber, IsSerialNumberArticle)
Set Conn = CWLStart.CurrentCompany.Connection
' Get 'Lagerortstruktur' for Product
SQL = "SELECT c178 FROM [V021] (NOLOCK) WHERE c010 = '"& ProductNumber &"'"
Set Result = Conn.Select(SQL)
If Result.Value("c178") = 0 Then
GetWinLineStorageLocation = 0
Exit Function
End If
If IsSerialNumberArticle = 1 Then
Identifier = GetWinLineInternalProductNumber(ProductNumber, ProductSerialNumber)
Else
Identifier = ProductNumber
End If
SQL = ""
SQL = SQL & "SELECT TOP 1 T335.c000 "
SQL = SQL & "FROM [T024] (NOLOCK), [T335] (NOLOCK), [T299] (NOLOCK) "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C001 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L1 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C002 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L2 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C003 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L3 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C004 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L4 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C005 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L5 "
SQL = SQL & "WHERE T299.C000 = '"& Identifier &"' AND T299.C000 = T024.C002 AND T299.MESOCOMP = '" & MandatorNr & "' AND (T299.MESOYEAR = " & WinLineCurrentYear & " OR T299.MESOYEAR = " & WinLineCurrentYear - 12 & ") AND T024.MESOCOMP = '" & MandatorNr & "' "
SQL = SQL & "AND (T024.MESOYEAR = " & WinLineCurrentYear & " OR T024.MESOYEAR = " & WinLineCurrentYear - 12 & ")AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ") AND (T299.C001 = T335.C020 AND T299.C002 = T335.C021 "
SQL = SQL & "AND T299.C003 = T335.C022 AND T299.C004 = T335.C023 AND T299.C005 = T335.C024 AND T299.C006 = T335.C025) "
SQL = SQL & "ORDER BY T335.c000 DESC, T299.C001,T299.C002,T299.C003,T299.C004,T299.C005,T299.C006"
If DEBUG_ON = True Then
AddDebugLine "SQL Part 1: " & Mid(SQL, 1, 750)
ShowDebugBox "GetWinLineStorageLocation"
AddDebugLine "SQL Part 2: " & Mid(SQL, 750)
ShowDebugBox "GetWinLineStorageLocation"
End If
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying storage location... " & vbNewline
AddDebugLine "ArticleNumber: " & ProductNumber
AddDebugLine "SerialNumber: " & ProductSerialNumber
AddDebugLine "IsSerialNumber Article: " & IsSerialNumberArticle
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineStorageLocation"
End If
If Result = -1 Then
GetWinLineStorageLocation = 0
Else
GetWinLineStorageLocation = Result.Value("c000")
End If
End Function

74
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/GetWinLineUserData.vbm Normal file
View File

@@ -0,0 +1,74 @@
' GetWinLineUserData(UserID: Int)
' ----------------------------------------------------------------------------
' Holt anhand der UserID Loginname, Namen und Durchwahl
' aus der Systemtabelle CWLSYSTEM.T002SRV
'
' Aus den Daten wird ein String aufgebaut, der dann in Meldungen
' verwendet werden kann.
'
' Returns: GetWinLineUserData : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 26.04.2021 / MP
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
Function GetWinLineUserData(UserID)
Err.Clear
GetWinLineUserData = ""
If Len(UserID) <= 0 Then
If DEBUG_ON = True Then
Msgbox "Parameter UserID ist leer!", vbExclamation, DEFAULT_TITLE & " - GetWinLineUserData"
End If
Exit Function
End If
Set Conn = CWLCompany.GetSystemConnection(cwlSystemServerSRV)
SQL = "SELECT TOP 1 c001, c026, c028 FROM T002SRV (NOLOCK) "
SQL = SQL & "WHERE c000 = " & UserID
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for Original Line Number.. " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineUserData"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetWinLineUserData"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - GetWinLineUserData"
Exit Function
End If
End If
ResultString = ""
If Len(Result.Value("c026")) > 0 Then
' Name des Benutzers
ResultString = Result.Value("c026")
Else
' Loginname des Benutzers, muss immer belegt sein.
ResultString = Result.Value("c001")
End If
If Len(Result.Value("c026")) > 0 Then
' Durchwahl ergänzen, wenn vorhanden
ResultString = ResultString & " (" & Result.Value("c028") & ")"
End If
GetWinLineUserData = ResultString
End Function

29
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/GetWindowsEnvironment.vbm Normal file
View File

@@ -0,0 +1,29 @@
' GetWindowsEnvironment(EnvName: String)
' ----------------------------------------------------------------------------
' URL: https://skriptwiki.ffsf.de/doku.php/umgebungsvariablen
'
' Mögliche Werte für EnvName sind hier zu finden:
' http://www.winfaq.de/faq_html/Content/tip0000/onlinefaq.php?h=tip0328.htm
'
' Returns: GetWindowsEnvironment : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 23.03.2021 / MP
' Version Date / Editor: 23.03.2021 / MP
' Version Number: 3.0.0.0
Function GetWindowsEnvironment(EnvName)
If (Len(EnvName) <= 0) Then
GetWindowsEnvironment = ""
Exit Function
End If
Set WshShell = CreateObject("WScript.Shell")
Set oEnv = WshShell.Environment("Process")
GetWindowsEnvironment = oEnv(EnvName)
Set oEnv = Nothing
End Function

234
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/ArticleExists.vbm Normal file
View File

@@ -0,0 +1,234 @@
' ArticleExists(Identifier: String)
' ----------------------------------------------------------------------------
' Findet Artikelnummer anhand von versch. Kriterien
' - Artikel-Nummer, Alternative Artikel-Nummer, EAN-Code, Seriennummer
' - Gibt die Zeile im Grid zurück in der Artikel das erste Mal gefunden wurde
'
' Returns: ArticleExists: Int
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.09.2020 / JJ
' Version Date / Editor: 06.04.2021 / MP
' Version Number: 3.0.0.4
Const ARTICLE_EXISTS_NO_STOCK = -99
Const ARTICLE_EXISTS_NO_SERIALNUMBER = -98
Const ARTICLE_EXISTS_NO_ARTICLE_EAN = -97
Const ARTICLE_EXISTS_NO_REGEX_MATCH = -96
Const ARTICLE_EXISTS_OVERSCANNED = -95
Function ArticleExists(Identifier)
ArticleExists = 0
HasError = False
CURRENT_SERIALNUMBER = ""
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' ===================== ARTIKEL NUMMER / EAN-CODE =====================
SQL = ""
' Artikelnummer / EAN-Code / Alternative Artikelnummer
SQL = SQL & "((C002 = '" & Identifier & "') Or (C075 = '" & Identifier & "') Or (C114 = '" & Identifier & "')) AND "
' Artikel darf nicht inaktiv sein
SQL = SQL & "(c038 IS NULL) "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultArtikel = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for Article by ArticleNo/EAN-Code.. " & vbNewline & vbNewline
AddDebugLine "Result Columns: " & ResultArtikel & vbNewline
AddDebugLine "Result Rows: " & ResultArtikel.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
' ===================== SERIENNUMMER =====================
SQL = ""
' Artikelnummer
SQL = SQL & "(C068 = '" & Identifier & "') AND "
' Artikel darf nicht inaktiv sein
SQL = SQL & "(c038 IS NULL) "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultSeriennummer = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for Article by Article serial number " & vbNewline
AddDebugLine "Result Columns: " & ResultSeriennummer
AddDebugLine "Result Rows: " & ResultSeriennummer.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
If ResultSeriennummer.RowCount > 0 Then
SerialNumberString = ResultSeriennummer.Value("C068")
MainArticleNumber = ResultSeriennummer.Value("C011")
SQL = ""
SQL = SQL & "(C002 = '" & MainArticleNumber & "') "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultMainArticle = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If ResultMainArticle.RowCount > 0 Then
SerialNumberPattern = ResultMainArticle.Value("C222")
End If
If DEBUG_ON = True Then
AddDebugLine "Preparing Regex Check. " & vbNewline
AddDebugLine "SerialNumberString: " & SerialNumberString
AddDebugLine "SerialNumberPattern: " & SerialNumberPattern
AddDebugLine "MainArticleNumber: " & MainArticleNumber
ShowDebugBox "ArticleExists"
End If
If Len(SerialNumberPattern) > 0 And Len(SerialNumberString) > 0 Then
Set SerialNumberRegex = New Regexp
With SerialNumberRegex
.Pattern = SerialNumberPattern
.IgnoreCase = False
.Global = False
End With
Set RegexMatch = SerialNumberRegex.Execute(SerialNumberString)
Set FirstMatch = RegexMatch.Item(0)
If DEBUG_ON = True Then
AddDebugLine "Checked Serialnumber against Regex. (1/2)" & vbNewline
AddDebugLine "FirstMatch.Length: " & FirstMatch.Length
AddDebugLine "Len(SerialNumberString): " & Len(SerialNumberString)
AddDebugLine "FirstMatch.FirstIndex: " & FirstMatch.FirstIndex
ShowDebugBox "ArticleExists"
End If
If Not (FirstMatch.Length = Len(SerialNumberString) And FirstMatch.FirstIndex = 0) Then
ArticleExists = ARTICLE_EXISTS_NO_REGEX_MATCH
HasError = True
End If
If DEBUG_ON = True Then
AddDebugLine "Checked Serialnumber against Regex. (2/2)" & vbNewline
AddDebugLine "Result: " & SerialNumberRegex.Test(SerialNumberString)
AddDebugLine "Serialnumber: " & SerialNumberString
AddDebugLine "Regex: " & SerialNumberPattern
ShowDebugBox "ArticleExists"
End If
End If
CURRENT_SERIALNUMBER = Identifier
Set Result = ResultSeriennummer
Else
Set Result = ResultArtikel
End If
'==========================================================
If HasError = True Then
' Just skip the rest of the function and return the current error
Elseif Result.RowCount > 0 Then
' Wir brauchen die Hauptartikelnummer, weil die Prüfung sonst bei SN-Artikeln fehlschlägt
MainArticleNumber = Result.Value("C011")
RealArticleNumber = Result.Value("C002")
ProductShape = 0
' Ausprägung des Artikels prüfen
SQL = ""
SQL = "SELECT c001 FROM t301 (NOLOCK) WHERE c003 = (SELECT c066 FROM v021 (NOLOCK) WHERE c002 = '" & RealArticleNumber & "' " & SQLQuery_BasicWhere & ")" & SQLQuery_BasicWhere
If DEBUG_ON = True Then
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
Set Result = CWLStart.CurrentCompany.Connection.Select(SQL)
If Result > -1 Then
ProductShape = Result.Value("c001")
Else
ProductShape = 0
End If
CURRENT_SHAPE = ProductShape
AmountStocked = GetWinLineStockedAmount(RealArticleNumber, False)
If DEBUG_ON = True Then
AddDebugLine "Checking stock of product: " & RealArticleNumber & " (" & MainArticleNumber & ")" & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "Stock: " & AmountStocked
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
If AmountStocked > 0 Then
If DEBUG_ON = True Then
AddDebugLine "Amount stocked: " & AmountStocked
End If
' Vorkommen in Tabelle prüfen
For GridLineIndex = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(GridLineIndex, COLUMN_ARTICLENUMBER)
Total = Cint(Grid.GetCellValue(GridLineIndex, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(GridLineIndex, COLUMN_SCANNED))
Amount = CInt(amountBox.ScreenContents)
If CurrentArticleNumber = MainArticleNumber Then
If DEBUG_ON = True Then
AddDebugLine "CurrentArticleNumber matches MainArticleNumber! (" & CurrentArticleNumber & ")"
End If
If Total > Scanned Then
If DEBUG_ON = True Then
AddDebugLine "Product is not yet scanned completely and exists in Row " & GridLineIndex & "!"
End If
If (Total - Scanned) >= Amount Then
ArticleExists = GridLineIndex
Exit For
Else
If GetCountInDuplList(CurrentArticleNumber) <= 1 Then
Exit For
End If
End If
Else
ArticleExists = ARTICLE_EXISTS_OVERSCANNED
End If
End If
Next
Else
If DEBUG_ON = True Then
AddDebugLine "Amount stocked: 0"
End If
ArticleExists = ARTICLE_EXISTS_NO_STOCK
End If
If DEBUG_ON = True Then
ShowDebugBox "ArticleExists"
End If
Else
If CURRENT_SERIALNUMBER = "" Then
ArticleExists = ARTICLE_EXISTS_NO_ARTICLE_EAN
Else
ArticleExists = ARTICLE_EXISTS_NO_SERIALNUMBER
End If
End If
End Function

82
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/CheckArticleGroupIsRelevant.vbm Normal file
View File

@@ -0,0 +1,82 @@
' CheckArticleGroupIsRelevant(ArticleGroup : Integer)
' ----------------------------------------------------------------------------
' Prüft, ob die übergebene Artikelgruppe am Packtisch bearbeitet/gescannt
' werden kann (true), oder ob es sich um eine "nicht-relevante" Artikelgruppe
' handelt (false), zb Versandkosten, die auf nicht sichtbar geschaltet wird.
'
' Geprüft wird gegen die Variable EXCLUDED_ARTICLEGROUPS, die im Fensterscript
' konfiguriert werden kann.
' Die Variable kann entweder genau einen Wert, einen unteren/oberen Grenzwert
' oder eine Liste von Werten enthalten.
' Erlaubte Beispiele:
' - Genau ein Wert: "100"
' - Grenzwert bis/ab dem dies gilt: "100-" / "100+"
' - Array von verschiedenen Werten: "100, 101, 102"
'
' Wenn keine Artikelgruppe als nicht-relevant definiert wurde oder die zu
' prüfende Artikelgruppe ist leer oder kleiner 1, wird True zurückgegeben.
'
' Returns: CheckArticlegroupIsRelevant : Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 24.06.2021 / MP
' Version Date / Editor: 28.06.2021 / MP
' Version Number: 3.0.0.4
Function CheckArticleGroupIsRelevant(ArticleGroup)
CheckArticleGroupIsRelevant = True
' Wenn die Variable leer ist, sind alle Artikelgruppen relevant
If Len(EXCLUDED_ARTICLEGROUPS) <= 0 Then
Exit Function
End If
' Ohne Wert geht gar nichts, auch Negative Werte sind sinnlos
If Len(ArticleGroup) <= 0 Or ArticleGroup < 0 Then
CheckArticleGroupIsRelevant = False
Exit Function
End If
' Wenn EXCLUDED_ARTICLEGROUPS ein Komma enthält, muss ein Array
' aus den Elementen erzeugt werden.
posKomma = InStr(EXCLUDED_ARTICLEGROUPS, ",")
If posKomma > 0 Then
exValueArray = Split(EXCLUDED_ARTICLEGROUPS, ",")
For Each exValue in exValueArray
If Cint(exValue) = ArticleGroup Then
CheckArticleGroupIsRelevant = False
Exit Function
End If
Next
Else
posPlus = InStr(EXCLUDED_ARTICLEGROUPS, "+")
posMinus = InStr(EXCLUDED_ARTICLEGROUPS, "-")
If posPlus > 0 Then
' + enthalten, die Variable enthält ein unteres Limit
limit = CInt(Mid(EXCLUDED_ARTICLEGROUPS, 1, posPlus-1))
If ArticleGroup >= limit Then
CheckArticleGroupIsRelevant = False
End If
ElseIf posMinus > 0 Then
' - enthalten, die Variable enthält ein oberes Limit
limit = CInt(Mid(EXCLUDED_ARTICLEGROUPS, 1, posMinus-1))
If ArticleGroup <= limit Then
CheckArticleGroupIsRelevant = False
End If
Else
' Die Variable enthält genau eine Artikelgruppe
If ArticleGroup = CInt(EXCLUDED_ARTICLEGROUPS) Then
CheckArticleGroupIsRelevant = False
End If
End If
End If
End Function

65
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/CheckMacroArticlesComplete.vbm Normal file
View File

@@ -0,0 +1,65 @@
' CheckMacroArticlesComplete()
' ----------------------------------------------------------------------------
' Prüft, ob die im Auftrag enthaltenen Macro-Artikel
' vollständig sind, und vermerkt die Infos im
' MACRO_ARTICLE_LIST-Array
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 08.03.2021 / MP
' Version Date / Editor: 08.03.2021 / MP
' Version Number: 3.0.0.0
Sub CheckMacroArticlesComplete()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount: Do
MacroFlag = Cint(Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG))
If MacroFlag = 1 Then
LineNumber = Cint(Grid.GetCellValue(GridIndex, COLUMN_LINE_NUMBER))
MacroArticleListIndex = -1
For MacroArrayIndex = 0 To UBound(MACRO_ARTICLE_LIST)
If MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = LineNumber Then
MacroArticleListIndex = MacroArrayIndex
Exit For
End If
Next
For InnerGridIndex = GridIndex + 1 To Grid.LineCount: Do
InnerMacroFlag = Cint(Grid.GetCellValue(InnerGridIndex, COLUMN_MACRO_FLAG))
If InnerMacroFlag = 2 Then
AmountTotal = Cint(Grid.GetCellValue(InnerGridIndex, COLUMN_TOTAL))
AmountScanned = Cint(Grid.GetCellValue(InnerGridIndex, COLUMN_SCANNED))
If AmountTotal <> AmountScanned Then
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_GRID_LINE_INDEX, MacroArticleListIndex) = GridIndex
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArticleListIndex) = False
' An der Stelle des unvollständigen Artikels weiter prüfen
GridIndex = InnerGridIndex
' Aus Makroartikel aussteigen, weil unvollständig
Exit For
End If
Else
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_GRID_LINE_INDEX, MacroArticleListIndex) = GridIndex
' An der Stelle des unvollständigen Artikels weiter prüfen
GridIndex = InnerGridIndex
' Aus Makroartikel aussteigen, weil vollständig
Exit For
End If
Loop While False: Next
Else
' Nächsten Artikel bearbeiten
Exit Do
End If
Loop While False: Next
End Sub

51
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/CheckOrderIsLocked.vbm Normal file
View File

@@ -0,0 +1,51 @@
' CheckOrderIsLocked(OrderNumber : String)
' ----------------------------------------------------------------------------
' Prüft, ob der Auftrag gesperrt ist.
' Wenn der Auftrag gesperrt ist, wird der Anwender informiert,
' wer die Sperre hält, und ob man es erneut versuchen möchte,
' oder Abbrechen will. Das Verhalten orientiert sich an der
' Vorlage, wie die Winline auf solche Sperrren reagiert.
'
' Returns: CheckOrderIsLocked : Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 07.04.2021 / MP
' Version Date / Editor: 07.04.2021 / MP
' Version Number: 3.0.0.2
Function CheckOrderIsLocked(OrderNumber)
CheckOrderIsLocked = False
If Len(OrderNumber) <= 0 Then
' Ohne Auftrag geht gar nichts
Exit Function
End If
Dim ContinueFlag : ContinueFlag = True
Do
UserId = IsOrderLocked(OrderNumber)
If UserId > 0 Then
CheckOrderIsLocked = True ' Rückgabewert
QuestionText = "Der Auftrag [" & OrderNumber & "] wird von Benutzr [" & GetWinLineUserData(UserID) & "] bearbeitet! " & vbNewLine & vbNewLine
Answer = MsgBox(QuestionText & "Wollen Sie abbrechen?", vbYesno + vbQuestion, DEFAULT_TITLE & " - CheckOrderIsLocked")
If Answer = vbYes Then
ContinueFlag = False ' Abbrechen
Else
ContinueFlag = True ' Weiter prüfen
End If
Else
CheckOrderIsLocked = False ' Rückgabewert
ContinueFlag = False
End If
Loop While ContinueFlag = true
End Function

294
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/CompleteOrder.vbm Normal file
View File

@@ -0,0 +1,294 @@
' CompleteOrder()
' ----------------------------------------------------------------------------
' Schließt die Prüfung ab und erstellt einen Lieferschein
'
' Returns: CompleteOrder : Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.09.2020 / JJ
' Version Date / Editor: 12.07.2021 / JJ
' Version Number: 3.0.0.4
Function CompleteOrder()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Conn = CWLStart.CurrentCompany.Connection
Set Grid = mywin.Controls.Item(GRID_ID).Grid
If MACRO_ARTICLE_COUNTER > 0 Then
Dim MacroArticleReseted : MacroArticleReseted = False
CheckMacroArticlesComplete()
For MacroArrayIndex = 0 To Ubound(MACRO_ARTICLE_LIST, 2)
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArrayIndex) = False) AND _
(MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_SCAN_FLAG, MacroArrayIndex) = True) Then
questionText = "Der Package-Artikel [" & MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_NUMBER, MacroArrayIndex) & "] ist unvollständig!" & vbNewLine & vbNewLine
Answer = MsgBox(questionText & "Soll das gesamte Package zurückgesetzt werden?", vbYesno + vbQuestion, DEFAULT_TITLE)
If Answer = vbYes Then
ResetValuesByMacroLineNumber MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex)
MacroArticleReseted = True
Else
CompletedPackages = Cint(InputBox("Wieviele Package-Artikel von insgesamt [" & MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_REMAINING, MacroArrayIndex) & "] werden damit ausgeliefert?", "Anzahl fertige Packages", "0"))
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex) = CompletedPackages
End If
End If
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArrayIndex) = True) Then
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex) = MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_REMAINING, MacroArrayIndex)
End If
Next
If MacroArticleReseted = True Then
Answer = MsgBox("Einer oder mehrere Package-Artikel wurden zurückgesetzt. Soll die Lieferscheinerstellung abgebrochen werden?", vbYesno + vbQuestion, DEFAULT_TITLE)
If Answer = vbYes Then
CompleteOrder = False
Exit Function
End If
End If
' Übertrage Macro-Daten zurück ins Grid
TransferMacroData()
End If
' Übertrage die Grid-Daten zurück in die Order-Datenstruktur
TransferGridData()
' Eine letzte Möglichkeit die Auftragsdaten zu tunen
UpdateOrderDataBeforeDelNote()
Dim OrderId, AccountSQL, MandatorId, RunningNumber
If DEBUG_ON = True Then
AddDebugLine "Completing order.. " & vbNewline
ShowDebugBox "CompleteOrder"
End If
OrderId = mywin.Controls.Item(ORDER_INPUT).ScreenContents
AccountSQL = "SELECT DISTINCT c021 FROM t025 (NOLOCK) WHERE c044 = '" & OrderId & "' " & SQLQuery_OrderWhere
Set AccountResult = Connection.Select(AccountSQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for CustomerAccountId.. " & vbNewline
AddDebugLine "Result Columns: " & AccountResult
AddDebugLine "Result Rows: " & AccountResult.RowCount
AddDebugLine "SQL: " & AccountSQL
ShowDebugBox "CompleteOrder"
End If
MandatorId = AccountResult.Value("c021")
RunningNumber = RUNNING_NUMBER_PREFIX & OrderId
BelegKey = Cstr(DateDiff("s", "01/01/1970 00:00:00", Now))
' ===================== KOPFDATEN =====================
Dim Request, URL, XML
Dim NowObject : NowObject = Now
Dim DateString : DateString = Year(NowObject) & "-" & GetLeftPad(Month(NowObject)) & "-" & GetLeftPad(Day(NowObject))
Dim TimeString : TimeString = GetLeftPad(Hour(NowObject)) & ":" & GetLeftPad(Minute(NowObject)) & ":" & GetLeftPad(Second(NowObject))
Dim UserNumber : UserNumber = Cwlstart.Currentuser.Number
Dim ComputerName : ComputerName = GetWindowsEnvironment("COMPUTERNAME")
' === WEB SERVICES =======================
XML = ""
XML = XML & "<?xml version=""1.0"" encoding=""UTF-8""?>"
XML = XML & "<MESOWebService TemplateType=""__TYPE__"" Template=""__VORLAGE__"" option=""__OPTION__"" printVoucher=""__PRINT__"">"
XML = XML & "<__VORLAGE__T025>"
XML = XML & "<BELEGKEY>" & BelegKey & "</BELEGKEY>"
XML = XML & "<Kontonummer>" & MandatorId & "</Kontonummer>"
XML = XML & "<Laufnummer>" & RunningNumber & "</Laufnummer>"
XML = XML & "<Auftragsnummer>" & OrderId & "</Auftragsnummer>"
XML = XML & "<Datum_Lieferschein>" & DateString & "</Datum_Lieferschein>"
If USE_ADDITIONAL_DBFIELDS = True Then
XML = XML & "<BenutzerNummerPacktisch>" & UserNumber & "</BenutzerNummerPacktisch>"
XML = XML & "<ErstellDatumPacktisch>" & DateString & " " & TimeString & "</ErstellDatumPacktisch>"
XML = XML & "<ComputerNamePacktisch>" & ComputerName & "</ComputerNamePacktisch>"
XML = XML & "<VersionPacktisch>" & PACKTISCH_VERSION & "</VersionPacktisch>"
End If
XML = XML & "</__VORLAGE__T025>"
' === EXIM TABELLE =======================
HeadSQL = "INSERT INTO " & SQLDB_for_EXIM & "." & SQLHeadTB_for_EXIM & " "
HeadSQL = HeadSQL & "(BELEGKEY, Kontonummer, Laufnummer, Auftragsnummer, Belegdatum) "
HeadSQL = HeadSQL & "VALUES("& BelegKey &", '"& MandatorId &"', '"& RunningNumber &"', '"& OrderId &"', GETDATE())"
HeadResult = Conn.ExecuteSQL(HeadSQL)
If DEBUG_ON = True Then
AddDebugLine "Inserting Head Data" & vbNewline
AddDebugLine "Result: " & HeadResult
AddDebugLine "SQL: " & HeadSQL
ShowDebugBox "CompleteOrder"
End If
' ===================== ENDE KOPFDATEN =====================
' ============================ MITTEDATEN ============================
Dim ArticleNumber, AmountScanned, SerialNumber, StorageLocation, LineNumber
For OrderArrayIndex = 0 To Ubound(ORDER_ARTICLE_DATA, 2): Do
IsSerialNumberArticle = Cint(ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex))
ArticleNumber = ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex)
SerialNumber = ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex)
AmountScanned = CInt(ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex))
LineNumber = CInt(ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex))
DataType = CInt(ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex))
VKPreisEinzel = Replace(ORDER_ARTICLE_DATA(INDEX_PRICE_VK_EINZEL, OrderArrayIndex), ",", ".")
IsOpen = ORDER_ARTICLE_DATA(INDEX_IS_OPEN, OrderArrayIndex)
If DEBUG_ON = True Then
AddDebugLine "Processing Article: " & ArticleNumber
AddDebugLine "SerialNumber: " & SerialNumber
AddDebugLine "LineNumber: " & LineNumber
AddDebugLine "DataType: " & DataType
AddDebugLine "IsOpen: " & IsOpen
ShowDebugBox "CompleteOrder"
End If
' Text-Artikel werden nicht übergeben
If DataType = 3 Then
Exit Do
End If
If PRINT_DOCUMENT_AFTER_COMPLETION = True Then
StorageLocation = GetWinLineStorageLocation(ArticleNumber, SerialNumber, IsSerialNumberArticle)
InternalArticleNumber = GetWinLineInternalProductNumber(ArticleNumber, SerialNumber)
Else
StorageLocation = 0
InternalArticleNumber = 0
End If
' === EXIM TABELLE =======================
MidSQL = "INSERT INTO " & SQLDB_for_EXIM & "." & SQLMiddleTB_for_EXIM & " "
MidSQL = MidSQL & "(BELEGKEY, Artikelnummer, Hauptartikelnummer, Zeilennummer, Datentyp, Mengegeliefert, ChargeIdentnummer, Lagerort, Einzelpreis) "
MidSQL = MidSQL & "VALUES (" & BelegKey & ", '" & ArticleNumber & "', '" & ArticleNumber & "', "
If IsSerialNumberArticle = 1 Then
MidSQL = MidSQL & LineNumber
Else
MidSQL = MidSQL & " NULL"
End If
MidSQL = MidSQL & ", '1', " & AmountScanned & ", '" & SerialNumber & "', " & StorageLocation& ", " & VKPreisEinzel & ")"
MidResult = Conn.ExecuteSQL(MidSQL)
' === WEB SERVICES =======================
MidXML = ""
' Abgeschlossene Belegzeilen werden nicht an den WebSerivce übergeben
If IsOpen = True Then
MidXML = MidXML & "<__VORLAGE__T026>"
MidXML = MidXML & "<BELEGKEY>" & BelegKey & "</BELEGKEY>"
MidXML = MidXML & "<Artikelnummer>" & InternalArticleNumber & "</Artikelnummer>"
MidXML = MidXML & "<Hauptartikelnummer>" & ArticleNumber & "</Hauptartikelnummer>"
MidXML = MidXML & "<Zeilennummer>" & LineNumber & "</Zeilennummer>"
MidXML = MidXML & "<Datentyp>" & "1" & "</Datentyp>"
MidXML = MidXML & "<Mengegeliefert>" & AmountScanned & "</Mengegeliefert>"
MidXML = MidXML & "<ChargeIdentnummer>" & SerialNumber & "</ChargeIdentnummer>"
MidXML = MidXML & "<Lagerort>" & StorageLocation & "</Lagerort>"
MidXML = MidXML & "<Einzelpreis>" & VKPreisEinzel & "</Einzelpreis>"
MidXML = MidXML & "</__VORLAGE__T026>"
End If
If DEBUG_ON = True Then
AddDebugLine "Inserting Middle Data" & vbNewline
AddDebugLine "For Article " & ArticleNumber
AddDebugLine "And Amount " & AmountScanned
AddDebugLine "Result: " & MidResult & vbNewline
AddDebugLine "SQL: " & MidSQL & vbNewline
AddDebugLine "XML: " & MidXML
ShowDebugBox "CompleteOrder"
End If
XML = XML & MidXML
Loop While False: Next
XML = XML & "</MESOWebService>"
XML = Replace(XML, "__VORLAGE__", WEB_VORLAGE)
XML = Replace(XML, "__TYPE__", WEB_TYPE)
XML = Replace(XML, "__PRINT__", WEB_PRINT)
XML = Replace(XML, "__OPTION__", WEB_OPTION)
URL = "http://__SERVER__/ewlservice/import?User=__USER__&Password=__PASSWORD__&Company=__COMPANY__&Type=30&Vorlage=__VORLAGE__&Actioncode=__ACTIONCODE__&byref=0&Data=__DATA__"
URL = Replace(URL, "__SERVER__", WEB_SERVER)
URL = Replace(URL, "__USER__", WEB_USER)
URL = Replace(URL, "__PASSWORD__", WEB_PASS)
URL = Replace(URL, "__COMPANY__", WEB_COMPANY)
URL = Replace(URL, "__VORLAGE__", WEB_VORLAGE)
URL = Replace(URL, "__ACTIONCODE__", WEB_ACTIONCODE)
URL = Replace(URL, "__DATA__", XML)
If DEBUG_ON = True Then
AddDebugLine "Sending Request to WebServices.."
AddDebugLine "URL: " & URL
AddDebugLine "WEB_PRINT: " & WEB_PRINT
AddDebugLine "WEB_OPTION: " & WEB_OPTION
ShowDebugBox "CompleteOrder"
End If
' ======================= ENDE MITTEDATEN =======================
If PRINT_DOCUMENT_AFTER_COMPLETION = True Then
' ===================== HTTP REQUEST =====================
Set Request = CreateObject("MSXML2.XMLHTTP")
Request.Open "POST", URL, False
Request.Send
Response = Request.ResponseText
Status = Request.Status
If DEBUG_ON = True Then
AddDebugLine "Response from WebServices!"
AddDebugLine "Status: " & Status
AddDebugLine "Body: " & Response
ShowDebugBox "CompleteOrder"
End If
' =================== ENDE HTTP REQUEST ==================
Error = False
Message = ""
If Status = 200 Then
If TestIsWebserviceResponseSuccessful(Response) = True Then
Message = "Lieferschein wurde übertragen!"
Else
Error = True
Message = "Lieferschein wurde nicht übertragen! Fehlerdetails: " & vbNewline & vbNewline & Response
End If
Else
Error = True
Message = "Fehler beim Zugriff auf Webservices aufgetreten!" & vbNewline & vbNewline & "Status: " & Status
End If
If Error = False Then
MsgBox Message, vbInformation, DEFAULT_TITLE
CompleteOrder = True
Else
MsgBox Message, vbExclamation, DEFAULT_TITLE & " - Fehler bei Abschluss"
CompleteOrder = False
End If
Else
CompleteOrder = True
End If
End Function

35
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/CountRowsForArticle.vbm Normal file
View File

@@ -0,0 +1,35 @@
' CountRowsForArticle(ArticleNumber : String)
' ----------------------------------------------------------------------------
' Gibt die Anzahl der Zeilen zu einer Artikelnummer zurück
'
' Returns: CountRowsForArticle : Int
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 25.09.2020 / JJ
' Version Date / Editor: 25.09.2020 / JJ
' Version Number: 1.0.0.0
Function CountRowsForArticle(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim Count : Count = 0
If DEBUG_ON = True Then
AddDebugLine "Counting rows for Article: " & ArticleNumber
ShowDebugBox "CountRowsForArticle"
End If
For GridIndex = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(GridIndex, COLUMN_ARTICLENUMBER)
If ArticleNumber = CurrentArticleNumber Then
Count = Count + 1
End If
Next
CountRowsForArticle = Count
End Function

392
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/DuplicateArticles.vbm Normal file
View File

@@ -0,0 +1,392 @@
' DuplicateArticles (ArticleNumber : String, MacroFlag : Int, ChargeFlag : Int)
' ----------------------------------------------------------------------------
' Funktionen zur Behandlung mehrfach vorkommender
' Artikelnummern. Daten werden im Array DUPL_ARTICLE_LIST
' gespeichert und verwaltet.
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 15.04.2021 / MP
' Version Date / Editor: 15.04.2021 / MP
' Version Number: 3.0.0.2
Const ARTICLE_IS_NOT_IN_DUPLICATES_LIST = -199
Const GRIDLINE_INDEX_IS_NOT_CHOOSEABLE = -198
Const NO_GRIDLINE_INDEX_CHOSEN = -197
CONST USE_ORIGINAL_ROW = -196
' Legt für jeden scannbaren Artikel einen Satz in der Duplikate-Struktur an
' und zählt wie oft dieser Artikel vorkommt.
' Für Artikel innerhalb eines Macros wird zusätzlich ein eigener Zähler hochgesetzt.
Sub AddArticleNumberToDuplList(ArticleNumber, MacroFlag, ChargeFlag)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex = ARTICLE_IS_NOT_IN_DUPLICATES_LIST Then
' Lege neue Zeile an
AddTwoDimArrayRow DUPL_ARTICLE_LIST
DuplArrayIndex = UBound(DUPL_ARTICLE_LIST, 2)
DUPL_ARTICLE_LIST(COLUMN_DUPL_ARTICLE_NUMBER, DuplArrayIndex) = ArticleNumber
DUPL_ARTICLE_LIST(COLUMN_DUPL_CHARGE_FLAG, DuplArrayIndex) = ChargeFlag
DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex) = 1
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) = 0
If (MacroFlag = 2) Then
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) = 1
End If
DUPL_ARTICLE_LIST(COLUMN_DUPL_GRID_LINE_INDEXE, DuplArrayIndex) = ""
Else
' Erhöhe Wert in bestehender Zeile
currentValue = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex) = currentValue + 1
If (MacroFlag = 2) Then
currentMacroValue = DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex)
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) = currentMacroValue + 1
End If
End If
End Sub
' Reduziert die Zähler für den Artikel, wenn eine Zeile vollständig gescannt wurde.
' Für Macro-Unterteile wird zusätzlich der MacroCounter reduziert
Sub ReduceCounterInDuplList(ArticleNumber, MacroFlag)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex >= 0 Then
' Vermindert Wert für den Artikel
currentValue = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex) = currentValue - 1
If (MacroFlag = 2) Then
currentMacroValue = DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex)
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) = currentMacroValue - 1
End If
End If
End Sub
' Reduziert die Zähler im Sub-Macro-Artikel-Token, wenn eine Zeile vollständig gescannt wurde.
' benötigt die ZeilenNummer des Macro Artikels
Sub ReduceSubMacroCounterInDuplList(ArticleNumber, MacroLineNumber)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex >= 0 Then
TestToken = "#" & MacroLineNumber & ","
CurrentMacroLineNumbers = DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex)
If Len(CurrentMacroLineNumbers) > 0 And InStr(CurrentMacroLineNumbers, TestToken) > 0 Then
'Counter reduzieren!
TempMacroLineNumbers = ""
SplittedTokens = Split(CurrentMacroLineNumbers)
For Each Token In SplittedTokens
If (InStr(Token, TestToken) > 0) Then
'Treffer, Counter auslesen, erhöhen und zurückschreiben
TempToken = Split(Token, ",")
TokenLen = Len(TempToken(1))-1
NewCount = CInt(Left(TempToken(1), TokenLen)) - 1
If NewCount > 0 Then
TempMacroLineNumbers = TempMacroLineNumbers & " " & TestToken & NewCount & "#"
End If
Else
' Kein Treffer, Token wieder zurückschreiben
TempMacroLineNumbers = TempMacroLineNumbers & " " & Token
End If
Next
CurrentMacroLineNumbers = TempMacroLineNumbers
End If
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex) = CurrentMacroLineNumbers
End If
End Sub
' Ergänzt die GridLine-Indexe für Artikel, die mehrfach vorkommen
' Bedingung: Der Artikel muss bereits in der Duplicate-Struktur
' enthalten sein, und einen Counter > 1 haben.
Sub AddGridLineIndexToDuplicateArticles(ArticleNumber, GridLineIndex)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex >= 0 Then
DuplCount = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
If DuplCount > 1 Then
CurrentGridLineIndexe = DUPL_ARTICLE_LIST(COLUMN_DUPL_GRID_LINE_INDEXE, DuplArrayIndex)
If Len(CurrentGridLineIndexe) > 0 Then
CurrentGridLineIndexe = CurrentGridLineIndexe & " " & FormatNumber(GridLineIndex, 0)
Else
CurrentGridLineIndexe = FormatNumber(GridLineIndex, 0)
End If
DUPL_ARTICLE_LIST(COLUMN_DUPL_GRID_LINE_INDEXE, DuplArrayIndex) = CurrentGridLineIndexe
End If
End If
End Sub
' Ergänzt die LineNumber der Macro-Hauptartikel für Macro-Sub-Artikel
' Gesammelt werden Tokens in der Form #LN,1#, wenn sie noch nicht vorkommen.
' Der Counter wird hochgezählt, um das Vorkommen des Artikels in verschiedenen Macros abzufangen
' Bedingung: Der Artikel muss bereits in der Duplicate-Struktur
' enthalten sein, und einen Counter > 1 haben.
Sub AddMacroLineNumberTokensToDuplicateArticles(ArticleNumber, MacroLineNumber)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If DuplArrayIndex >= 0 Then
DuplCount = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
If DuplCount > 1 Then
TestToken = "#" & MacroLineNumber & ","
CurrentMacroLineNumbers = DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex)
If Len(CurrentMacroLineNumbers) <= 0 Then
CurrentMacroLineNumbers = TestToken & "1#"
ElseIf InStr(CurrentMacroLineNumbers, TestToken) = 0 Then
CurrentMacroLineNumbers = CurrentMacroLineNumbers & " " & TestToken & "1#"
Else
'Counter erhöhen!
TempMacroLineNumbers = ""
SplittedTokens = Split(CurrentMacroLineNumbers)
For Each Token In SplittedTokens
If (InStr(Token, TestToken) > 0) Then
'Treffer, Counter auslesen, erhöhen und zurückschreiben
TempToken = Split(Token, ",")
TokenLen = Len(TempToken(1))-1
NewCount = CInt(Left(TempToken(1), TokenLen)) + 1
TempMacroLineNumbers = TempMacroLineNumbers & " " & TestToken & NewCount & "#"
Else
' Kein Treffer, Token wieder zurückschreiben
TempMacroLineNumbers = TempMacroLineNumbers & " " & Token
End If
Next
CurrentMacroLineNumbers = TempMacroLineNumbers
End If
DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex) = CurrentMacroLineNumbers
End If
End If
End Sub
' Prüfe, ob eine Artikelnummer bereits in dem Array enthalten ist
' oder nicht
' Rueckgabewert: Index des Artikels im Array, wenn bereits vorhande, sonst -1 falls nicht vorhanden
Function ExistArticleInDuplList(ArticleNumber)
ExistArticleInDuplList = ARTICLE_IS_NOT_IN_DUPLICATES_LIST
If (UBound(DUPL_ARTICLE_LIST, 2) > -1) Then
For DuplArrayIndex = 0 To UBound(DUPL_ARTICLE_LIST, 2)
If (DUPL_ARTICLE_LIST(COLUMN_DUPL_ARTICLE_NUMBER, DuplArrayIndex) = ArticleNumber) Then
ExistArticleInDuplList = DuplArrayIndex
Exit For
End If
Next
End If
End Function
' Zählt die MacroLineNumber-Tokens für den Artikel, und gibt
' die Anzahl zurück
Function GetMacroLineNumberCount(DuplArrayIndex)
Count = 0
SplittetTokens = Split(Trim(DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_LINE_NUMBERS, DuplArrayIndex)))
For Each Element In SplittetTokens
Count = Count + 1
Next
GetMacroLineNumberCount = Count
End Function
' Die Funktion gibt die Anzahl der Vorkommen des Artikels zurück.
' Für Macro-Sub-Artikel wird noch der Macro-Counter ausgewertet
Function GetCountInDuplList(ArticleNumber)
GetCountInDuplList = 0
For DuplArrayIndex = 0 To UBound(DUPL_ARTICLE_LIST, 2)
If (DUPL_ARTICLE_LIST(COLUMN_DUPL_ARTICLE_NUMBER, DuplArrayIndex) = ArticleNumber) Then
' COLUMN_DUPL_ROW_COUNT enthält die Gesamtzahl der Vorkommen
DuplCounter = DUPL_ARTICLE_LIST(COLUMN_DUPL_ROW_COUNT, DuplArrayIndex)
If (DuplCounter > 1) Then
' Wenn mehr als 1 Zeile übrig ist und es ein SN-Artikel ist, müssen wir genauer prüfen,
' ob wir die Auswahlbox anzeigen sollen.
ChargeFlag = DUPL_ARTICLE_LIST(COLUMN_DUPL_CHARGE_FLAG, DuplArrayIndex)
If (ChargeFlag = 2) Then
' Gibt es noch SN-Artikel in Makros? und in wievielen unterschiedlichen Macros?
macroRowCounter = cint(DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex)) ' Anzahl Artikel innerhalb von Macros
macroLineCounter = cint(GetMacroLineNumberCount(DuplArrayIndex)) ' Anzahl unterschiedlicher Macros
' Die Abfragebox muss kommen, wenn
' a) SN-Artikel in mehreren unterschiedlichen Macros vorkommen
' b) SN-Artikel innerhalb und ausserhalb von Macros vorkommen
' --> Wir geben die komplette Menge DuplCounter zurück!
' Die Box darf nicht kommen, wenn
' c) wenn SN-Artikel nur ausserhalb von Macros vorkommen
' d) SN-Artikel nur noch in einem Bereich auftauchen,
' --> Wir geben 1 als DuplCounter zurück!
If (macroLineCounter = 0 OR _
(macroLineCounter = 1 AND DuplCounter = macroRowCounter)) Then
DuplCounter = 1
End If
End If
End If
GetCountInDuplList = DuplCounter
Exit For
End If
Next
End Function
' Funktion, die die gewählte Auswahl der InputBox auswertet
' Rückgabewert: gewählte Zeilennummer oder Fehler
Function ChooseGridLineIndexFromDuplicates(ArticleNumber)
NoValidIndexSelected = True
ChooseGridLineIndexFromDuplicates = -1
Do
RetValue = ShowDuplicateInputBox(ArticleNumber)
If RetValue = ARTICLE_IS_NOT_IN_DUPLICATES_LIST Then
' Der Artikel kommt nicht im Array vor. Abbruch.
NoValidIndexSelected = False
ChooseGridLineIndexFromDuplicates = -1
ElseIf RetValue = USE_ORIGINAL_ROW Then
' Verwende einfach die schon gefundene Zeile
NoValidIndexSelected = False
ChooseGridLineIndexFromDuplicates = USE_ORIGINAL_ROW
ElseIf RetValue = NO_GRIDLINE_INDEX_CHOSEN Then
' Leere Auswahl oder Abbruch - OK
Answer = MsgBox("Wollen Sie die Scanergebnisse für Artikel [" & ArticleNumber & "] wirklich verwerfen?", vbYesno + vbQuestion, DEFAULT_TITLE)
If Answer = vbYes Then
NoValidIndexSelected = False
ChooseGridLineIndexFromDuplicates = -1
End If
ElseIf RetValue > 0 Then
' Gültiger Wert wurde ausgewählt
NoValidIndexSelected = False
ChooseGridLineIndexFromDuplicates = RetValue
Else
' Falsche Auswahl - Erneut die InputBox anzeigen.
MsgBox "Die gewählte Zeile steht nicht zur Auswahl. Bitte wählen Sie erneut.", vbOKOnly + vbExclamation, DEFAULT_TITLE
End If
Loop While NoValidIndexSelected
End Function
' Die Funktion zeigt eine InputBox mit den Informationen über
' doppelte Artikel.
' Rückgabewert: GridLineIndex der Position die bebucht werden soll
Function ShowDuplicateInputBox(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
ScannedAmount = Cint(amountBox.Contents)
DuplArrayIndex = ExistArticleInDuplList(ArticleNumber)
If (DuplArrayIndex < 0) Then
ShowDuplicateInputBox = ARTICLE_IS_NOT_IN_DUPLICATES_LIST
Exit Function
End If
ChargeFlag = DUPL_ARTICLE_LIST(COLUMN_DUPL_CHARGE_FLAG, DuplArrayIndex)
If ChargeFlag = 2 Then
' Anzeige für SN-Artikel macht nur Sinn, wenn Macro-Artikel involviert sind.
If DUPL_ARTICLE_LIST(COLUMN_DUPL_MACRO_ROW_COUNT, DuplArrayIndex) <= 0 Then
ShowDuplicateInputBox = USE_ORIGINAL_ROW
Exit Function
End If
End If
Dim ChooseableTokens : ChooseableTokens = "" 'Enthält die erlaubten Werte für die Auswahl
Dim AlreadyUsedAreasTokens : AlreadyUsedAreasTokens = "" ' #0# = Normaler Artikel, sonst MacroLineIndex
Dim InputTitle : InputTitle = DEFAULT_TITLE & " - Auswahl einer Zeilennummer"
Dim InputDefault : InputDefault = "" ' Hier machen wir bewusst nichts!
InputPrompt = "Der Artikel [" & ArticleNumber & "] kommt mehrfach im Auftrag vor: " & vbNewLine & vbNewLine
SplittetValues = Split(DUPL_ARTICLE_LIST(COLUMN_DUPL_GRID_LINE_INDEXE, DuplArrayIndex))
For Each GridLineIndex In SplittetValues : Do
Total = Cint(Grid.GetCellValue(Cint(GridLineIndex), COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(Cint(GridLineIndex), COLUMN_SCANNED))
Amount = Total - Scanned
If (Amount > 0) Then
MacroFlag = Cint(Grid.GetCellValue(Cint(GridLineIndex), COLUMN_MACRO_FLAG))
If (ChargeFlag = 0) Then
' Normale Artikel
ChooseableTokens = ChooseableTokens & " #" & GridLineIndex & "# "
InputPrompt = InputPrompt & "Zeile " & GridLineIndex & vbTab & " - Menge " & Amount
If MacroFlag = 2 Then
InputPrompt = InputPrompt & " (Package)"
End If
InputPrompt = InputPrompt & vbNewLine
Else
' SN-Artikel / Späte Ausprägungen
' Hier muss entschieden werden, ob ein Satz überhaupt angezeigt werden soll
MacroLineNumberToken = "#" & Grid.GetCellValue(Cint(GridLineIndex), COLUMN_MACRO_LINE_NUMBER) & "#"
If (InStr(AlreadyUsedAreasTokens, MacroLineNumberToken) = 0) Then
AlreadyUsedAreasTokens = AlreadyUsedAreasTokens & " " & MacroLineNumberToken
ChooseableTokens = ChooseableTokens & " #" & GridLineIndex & "# "
InputPrompt = InputPrompt & "Zeile " & GridLineIndex & vbTab & " - Menge " & Amount
If MacroFlag = 2 Then
InputPrompt = InputPrompt & " (Package)"
End If
InputPrompt = InputPrompt & vbNewLine
Else
Exit Do
End If
End If
End If
Loop While False: Next
InputPrompt = InputPrompt & vbNewLine & "Auf welche Zeile soll die gescannte Menge [" & ScannedAmount & "] gebucht werden?"
inputBoxValue = InputBox(InputPrompt, InputTitle, InputDefault)
Select Case True
Case IsEmpty(inputBoxValue)
' Abbruchbutton der InputBox geklickt
ShowDuplicateInputBox = NO_GRIDLINE_INDEX_CHOSEN
Case "" = Trim(inputBoxValue)
' Kein Wert eingegeben und OK geklickt
ShowDuplicateInputBox = NO_GRIDLINE_INDEX_CHOSEN
Case Else
' Wert eingegeben und OK geklickt
testToken = "#" & inputBoxValue & "#"
If (InStr(ChooseableTokens, testToken) > 0) Then
' Alles Rotscha in Kambodscha!
ShowDuplicateInputBox = inputBoxValue
Else
' Ungültiger Wert
ShowDuplicateInputBox = GRIDLINE_INDEX_IS_NOT_CHOOSEABLE
End If
End Select
End Function

48
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/GetArticleNumberFromSecondaryIndentifier.vbm Normal file
View File

@@ -0,0 +1,48 @@
' GetArticleNumberFromSecondaryIndentifier(Identifier : String)
' ----------------------------------------------------------------------------
' Gibt die Artikelnummer für Spät-Auspräge-Artikel zurück
'
' Returns: GetArticleNumberFromSecondaryIndentifier : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 23.10.2020 / JJ
' Version Date / Editor: 23.11.2020 / JJ
' Version Number: 1.0.0.0
Function GetArticleNumberFromSecondaryIndentifier(Identifier)
SQL = ""
' EAN-Code / Alternative Artikelnummer 1 / Alternative Artikelnummer 2 / Artikelnummer / S/N
SQL = SQL & "("
SQL = SQL & "(C002 = '" & Identifier & "') Or "
SQL = SQL & "(C068 = '" & Identifier & "') Or "
SQL = SQL & "(C075 = '" & Identifier & "') Or "
SQL = SQL & "(C114 = '" & Identifier & "') Or "
SQL = SQL & "(C115 = '" & Identifier & "')"
SQL = SQL & ") "
' Nur Nach Hauptartikel/Ausprägungs(kind)artikel suchen
' SQL = SQL & "And C014 IN (0, 2)"
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for SerialNumber-Regex by ArticleNumber " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetArticleNumberFromSecondaryIndentifier"
End If
If Result.RowCount > 0 Then
GetArticleNumberFromSecondaryIndentifier = Result.Value("c010")
Else
GetArticleNumberFromSecondaryIndentifier = ""
End If
End Function

37
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/GetNextFreeArticleRow.vbm Normal file
View File

@@ -0,0 +1,37 @@
' GetNextFreeArticleRow(ArticleNumber : String)
' ----------------------------------------------------------------------------
' Gibt den Grid Index der nächsten freien Zeile für das Scan-Ergebnis zurück
'
' Returns: GetNextFreeArticleRow : Int
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 30.09.2020 / JJ
' Version Date / Editor: 30.09.2020 / JJ
' Version Number: 1.0.0.0
Function GetNextFreeArticleRow(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim NextFreeRow : NextFreeRow = -1
If DEBUG_ON = True Then
AddDebugLine "Getting next free row for Article: " & ArticleNumber
ShowDebugBox "GetNextFreeArticleRow"
End If
For GridIndex = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(GridIndex, COLUMN_ARTICLENUMBER)
CurrentSerialNumber = Grid.GetCellValue(GridIndex, COLUMN_SERIALNUMBER)
If UCase(ArticleNumber) = UCase(CurrentArticleNumber) And Len(CurrentSerialNumber) = 0 Then
NextFreeRow = GridIndex
Exit For
End If
Next
GetNextFreeArticleRow = NextFreeRow
End Function

68
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/IsOrderAvailable.vbm Normal file
View File

@@ -0,0 +1,68 @@
' IsOrderAvailable(OrderNumber : String)
' ----------------------------------------------------------------------------
' Überprüft, ob Auftrag noch (teilweise) offen ist
'
' Returns: OrderAvailable: Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.09.2020 / JJ
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
Function IsOrderAvailable(OrderNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Err.Clear
IsOrderAvailable = False
'Set SQL Table and Query for DocHead. Default: "T025"
'c023 - c026 = Druckstufen; c098 = Freigabeflag Angebot; c139 = Belegstufe;
'c035 = Belegart
'--> Query is not complete, will be build in the script later this time!
SQL = ""
SQL = SQL & "(c044 = '" & OrderNumber & "') "
SQL = SQL & "AND (c024 = '*' AND c025 != '*' AND c026 != '*') " ' Auftrag gedruckt, LS/Rech noch nicht gedruckt.
SQL = SQL & "AND (c025 IN ('M', 'A', 'S')) " ' Druckstatus Lieferschein
SQL = SQL & "AND (c115 < 900) " ' Flag Freigabekontrolle Auftrag
SQL = SQL & "AND (c139 = 2) " ' Belegstufe 2 = Auftrag
SQL = SQL & SQLQuery_OrderWhere
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_25, SQL)
If DEBUG_ON = True Then
MsgBox "SQL: ... FROM " & TABLE_25 & " WHERE " & SQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Checking For Order by OrderId.." & vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "IsOrderAvailable"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei SQL-Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - IsOrderAvailable"
Exit Function
Else
Message = "Der Auftrag [" & OrderNumber & "] wurde nicht geladen aus einem der folgenden Gründe:" & vbNewLine & vbNewLine
Message = Message & "- Auftrag existiert nicht" & vbNewLine
Message = Message & "- Auftrag ist durch Fibu gesperrt" & vbNewLine
Message = Message & "- Auftrag wurde bereits erledigt" & vbNewLine
Message = Message & "- Beleg ist kein Auftrag"
MsgBox Message, vbExclamation, DEFAULT_TITLE
Exit Function
End If
End If
If Result.RowCount > 0 Then
IsOrderAvailable = True
End If
End Function

38
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/IsOrderComplete.vbm Normal file
View File

@@ -0,0 +1,38 @@
' IsOrderComplete()
' ----------------------------------------------------------------------------
' Überprüft, ob alle Zeilen vollständig gescannt wurden
'
' Returns: OrderComplete: Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 25.09.2020 / JJ
' Version Date / Editor: 01.04.2020 / MP
' Version Number: 3.0.0.2
Function IsOrderComplete()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
IsOrderComplete = True
For GridIndex = 1 To Grid.LineCount: Do
Total = Cint(Grid.GetCellValue(GridIndex, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(GridIndex, COLUMN_SCANNED))
MacroFlag = Cint(Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG))
If MacroFlag = 1 Then
' Continue weil Makro-Haupt-Artikel nicht geprüft werden
' Sonstige Artikel, wie z.B. Versandkosten, werden bereits als komplett ins Grid geladen
Exit Do
End If
If Scanned < Total Then
IsOrderComplete = False
Exit For
End If
Loop While False: Next
End Function

86
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/IsOrderLocked.vbm Normal file
View File

@@ -0,0 +1,86 @@
' IsOrderLocked(OrderNumber : Int)
' ----------------------------------------------------------------------------
' Gibt die UserID des Benutzers zurück, der den Auftrag sperrt.
' Wenn der Auftrag nicht gesperrt ist, wird 0 zurückgegeben.
'
' Returns: IsOrderLocked: Int
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 26.04.2021 / MP
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
' Hole die interne Belegnummer
' t025.c021 = Kontonummer und t025.c022 = Laufende Nummer
Function GetInternalOrderNumber(OrderNumber)
GetInternalOrderNumber = ""
Err.Clear
If Len(OrderNumber) > 0 Then
Set Conn = CWLStart.Connection
Dim SQL : SQL = ""
SQL = SQL & " SELECT TOP 1 c021, c022"
SQL = SQL & " FROM t025 (NOLOCK) "
SQL = SQL & " WHERE c044 = '"& OrderNumber & "'"
SQL = SQL & SQLQuery_OrderWhere
SQL = SQL & " ORDER BY c022"
Set Result = Conn.Select(SQL)
If Result < 0 Then
If err <> 0 Then
MsgBox "Fehler bei SQL-Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetInternalOrderNumber"
Exit Function
Else
Message = "Den Auftrag [" & OrderNumber & "] gibt es nicht in der Datenbank"
MsgBox Message, vbExclamation, DEFAULT_TITLE
Exit Function
End If
End If
GetInternalOrderNumber = result.Value("c021") & result.Value("c022")
End If
End Function
Function IsOrderLocked(OrderNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Err.Clear
IsOrderLocked = 0
InternalOrderNumber = GetInternalOrderNumber(OrderNumber)
SQL = ""
SQL = SQL & " c001 = 'E" & InternalOrderNumber & "' "
SQL = SQL & SQLQuery_BasicWhere
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_499, SQL)
If DEBUG_ON = True Then
MsgBox "SQL: ... FROM " & TABLE_499 & " WHERE " & SQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Checking For Order by internal OrderId [" & InternalOrderNumber & "]:"& vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "IsOrderLocked"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - IsOrderLocked"
Exit Function
End If
End If
If Result.RowCount > 0 Then
IsOrderLocked = Result.Value("C002")
End If
End Function

459
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/LoadOrder.vbm Normal file
View File

@@ -0,0 +1,459 @@
' LoadOrder(OrderNumber : String)
' ----------------------------------------------------------------------------
' Sucht Belegzeilen zur angegebenen Belegnummer
' - Filtert Artikel der konf. Artikelgruppe (EXCLUDED_ARTICLEGROUPS) aus
' - Lädt Ergebnisse in eine Tabelle auf dem Formular
' - Erzeugt N Zeilen für Seriennummer-Artikel der Menge N
'
' Returns: LoadOrder : Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.09.2020 / JJ
' Version Date / Editor: 12.07.2021 / JJ
' Version Number: 3.0.0.4
Function GetSQL(OrderNumber)
Dim SQL : SQL = ""
SQL = SQL & " SELECT t2.*, t3.c037 c2137, t3.c079 c2179, t3.c222 c21222"
SQL = SQL & " FROM t025 t (NOLOCK)"
SQL = SQL & " JOIN t026 t2 (NOLOCK) ON t.c021 = t2.c044 AND t.c022 = t2.c045"
SQL = SQL & " LEFT OUTER JOIN v021 t3 (NOLOCK) ON t2.c003 = t3.c002 AND t2.mesoyear = t3.mesoyear"
SQL = SQL & " WHERE t.c044 = '"& OrderNumber &"' AND t.c045 IS NULL"
SQL = SQL & " AND (t2.c099 = 0)"
'SQL = SQL & " AND (t2.c005 - t2.c016) > 0 AND (t2.c099 = 0)"
' Nach Mandant und Wirtschaftsjahr filtern
OrderWhere = SQLQuery_OrderWhere
OrderWhere = Replace(OrderWhere, "mesocomp", "t2.mesocomp")
OrderWhere = Replace(OrderWhere, "mesoyear", "t2.mesoyear")
SQL = SQL & OrderWhere
' Nach Zeilennummer sortieren
SQL = SQL & " ORDER BY t2.c000"
GetSQL = SQL
End Function
Function GetMacroArticleCount(MacroName)
Dim CountResult : CountResult = 0
If Len(MacroName) > 0 Then
Set Conn = CWLStart.Connection
Dim SQL : SQL = ""
SQL = SQL & " SELECT count(*) c001"
SQL = SQL & " FROM t326 (NOLOCK) "
SQL = SQL & " WHERE c002 like '"& MacroName &"%'"
SQL = SQL & SQLQuery_BasicWhere
Set Result = Conn.Select(SQL)
CountResult = result.Value("c001")
End If
GetMacroArticleCount = CountResult
End Function
Function FillOrderArticleData(OrderNumber)
Set Conn = CWLStart.Connection
Err.Clear
SQL = GetSQL(OrderNumber)
Set Result = Conn.Select(SQL)
Set CountResult = Result
If DEBUG_ON = True Then
MsgBox "SQL:" & SQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Searching For Order by OrderId (Mid Table).." & vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "LoadOrder"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - LoadOrder"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - LoadOrder"
Exit Function
End If
End If
' Belegung globaler Variablen für späteren Gebrauch
ORDER_ACCOUNT_NUMBER = Result.Value("c044")
ORDER_RUNNING_NUMBER = Result.Value("c045")
' Makro-Gruppenwechsel
Dim macroSubArticleCounter : macroSubArticleCounter = 0
Dim macroFlagForSNArticles : macroFlagForSNArticles = 0
Dim macroName : macroName = ""
Dim macroLineNumber : macroLineNumber = 0
Dim macroMaxLineNumber : macroMaxLineNumber = 0 ' Größte Zeilennummer eines Macros
Dim IsLateShape : IsLateShape = 0
OrderArrayIndex = 0
MacroArrayIndex = 0
' Doppelte Do Schleife, um ein "Continue While" zu ermöglichen
Do: Do
macroFlagForSNArticles = 0
AddTwoDimArrayRow ORDER_ARTICLE_DATA
ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) = result.Value("c078")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex) = result.Value("c003")
ORDER_ARTICLE_DATA(INDEX_MAIN_ARTICLE_NUMBER, OrderArrayIndex) = result.Value("c011")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex) = result.Value("c012")
ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) = result.Value("c042")
ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex) = result.Value("c2137")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_TYPE, OrderArrayIndex) = result.Value("c2179")
ORDER_ARTICLE_DATA(INDEX_DESCRIPTION, OrderArrayIndex) = result.Value("c004")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) = result.Value("c005")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex) = result.Value("c016")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_REMAINING, OrderArrayIndex) = result.Value("c099")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex) = ""
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) = result.Value("c055")
ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_ARTICLE_REGEX, OrderArrayIndex) = result.Value("c21222")
ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = False
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_MACRO_LINE_NUMBER, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_PRICE_VK_EINZEL, OrderArrayIndex) = result.Value("c007")
ORDER_ARTICLE_DATA(INDEX_IS_OPEN, OrderArrayIndex) = False
' Alle Belegzeilen, die schon geliefert wurden, werden von der Restlichen Logik nicht berührt
If (ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) - ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex)) <= 0 Then
' Vorzeitiger Abbruch, trotzdem den Zähler erhöhen
OrderArrayIndex = OrderArrayIndex + 1
Exit Do
Else
ORDER_ARTICLE_DATA(INDEX_IS_OPEN, OrderArrayIndex) = True
End If
If (Len(ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex)) > 0) Then
' Hier haben wir den Makro-Hauptartikel gefunden
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = 1
AddTwoDimArrayRow MACRO_ARTICLE_LIST
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex)
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_NUMBER, MacroArrayIndex) = ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex)
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_DESCRIPTION, MacroArrayIndex) = ORDER_ARTICLE_DATA(INDEX_DESCRIPTION, OrderArrayIndex)
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_REMAINING, MacroArrayIndex) = ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) - ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex)
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex) = 0
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArrayIndex) = True 'Wird umgesetzt, falls unvollständig
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_GRID_LINE_INDEX, MacroArrayIndex) = 0
MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_SCAN_FLAG, MacroArrayIndex) = False
MacroArrayIndex = MacroArrayIndex + 1
macroLineNumber = ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex)
macroName = ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex)
macroSubArticleCounter = GetMacroArticleCount(ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex)) ' Problematisch bei Teillieferungen
macroMaxLineNumber = macroLineNumber + macroSubArticleCounter
End If
If (ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = 0 And _
macroSubArticleCounter > 0 And _
ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) <= macroMaxLineNumber) Then
' Dies muss ein Sub-Makro-Hauptartikel sein
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = 2
' Makro Name für Sub-Makro-Artikel speichern
ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex) = macroName
' Makro Zeilennummer für Sub-Makro-Artikel speichern
ORDER_ARTICLE_DATA(INDEX_MACRO_LINE_NUMBER, OrderArrayIndex) = macroLineNumber
' Nachfolgende S/N Artikel bekommen das gleiche Flag
macroFlagForSNArticles = ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex)
macroSubArticleCounter = macroSubArticleCounter - 1
ElseIf (macroSubArticleCounter = 0 OR _
ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) > macroMaxLineNumber) Then
macroLineNumber = 0
macroMaxLineNumber = 0
End if
If CheckArticleGroupIsRelevant(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)) = False Then
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) - ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex)
End If
' Alle Nicht-Artikel (z.B Texte) immer mit Menge 0
If ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) <> 1 Then
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) = 0
End If
' Sichtbar Ja / Nein?
If (ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) = 1 And _
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) <> 12 And _
CheckArticleGroupIsRelevant(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)) = True) Then
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True
End If
' Wenn Option Alle Artikel Sichtbar aktiv ist
If (OPTION_ALL_ARTICLES > 0 And _
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = False) Then
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True
End If
If (ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) = 2) Then
ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex) = 1
End If
If (Len(ORDER_ARTICLE_DATA(INDEX_ARTICLE_REGEX, OrderArrayIndex)) > 0) Then
ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex) = 1
IsLateShape = 1
Else
ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex) = 0
IsLateShape = 0
End If
If (Len(Result.Value("c067")) > 0) Then
' Belegung hier, weil Text-Artikel keine Belegnummer enthalten
ORDER_DOCUMENT_NUMBER = Result.Value("c067")
End If
' Duplikate scanbarer Artikel ermitteln
If (ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) = 1 And _
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) <> 12 And _
CheckArticleGroupIsRelevant(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)) = True And _
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) <> 1) Then
AddArticleNumberToDuplList ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex), _
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex), _
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex)
End If
Dim AmountOrdered, AmountDelivered, ChargeFlag
ChargeFlag = CInt(result.Value("c055"))
AmountOrdered = CInt(result.Value("c005"))
AmountDelivered = CInt(result.Value("c016"))
Amount = AmountOrdered - AmountDelivered
If ChargeFlag = 2 Then
' Amount wird um 1 reduziert, da für den Artikel bereits
' eine Zeile aus der Schleife oben existiert
For Index = 1 To Amount - 1
AddTwoDimArrayRow ORDER_ARTICLE_DATA
OrderArrayIndex = OrderArrayIndex + 1
ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) = result.Value("c078")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex) = result.Value("c003")
ORDER_ARTICLE_DATA(INDEX_MAIN_ARTICLE_NUMBER, OrderArrayIndex) = result.Value("c011")
ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex) = result.Value("c012")
ORDER_ARTICLE_DATA(INDEX_DATA_TYPE, OrderArrayIndex) = result.Value("c042")
ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex) = macroName
ORDER_ARTICLE_DATA(INDEX_ARTICLE_TYPE, OrderArrayIndex) = result.Value("c2179")
ORDER_ARTICLE_DATA(INDEX_DESCRIPTION, OrderArrayIndex) = result.Value("c004")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) = result.Value("c005")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex) = result.Value("c016")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_REMAINING, OrderArrayIndex) = result.Value("c099")
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = 0
ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex) = ""
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex) = result.Value("c055")
ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex) = 1
ORDER_ARTICLE_DATA(INDEX_ARTICLE_REGEX, OrderArrayIndex) = result.Value("c21222")
ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex) = IsLateShape
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex) = macroFlagForSNArticles
ORDER_ARTICLE_DATA(INDEX_MACRO_LINE_NUMBER, OrderArrayIndex) = macroLineNumber
ORDER_ARTICLE_DATA(INDEX_PRICE_VK_EINZEL, OrderArrayIndex) = result.Value("c007")
ORDER_ARTICLE_DATA(INDEX_IS_OPEN, OrderArrayIndex) = True
' Wir benötigen die korrekte Anzahl der Zeilen eines Artikels
AddArticleNumberToDuplList ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex), _
ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex), _
ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex)
Next
End If
OrderArrayIndex = OrderArrayIndex + 1
' Doppelte Do Schleife, um ein "Continue While" zu ermöglichen
Loop While False: Loop While Result.NextRecord = True
' Enthält die Anzahl der Macro-Hauptartikel
MACRO_ARTICLE_COUNTER = MacroArrayIndex
FillOrderArticleData = OrderArrayIndex
End Function
Function LoadOrder(OrderNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
ASK_FOR_DELNOTE = False
If (FillOrderArticleData(OrderNumber) <= 0) Then
LoadOrder = False
Exit Function
ElseIf (ExistVisibleRows() = False) Then
' Es gibt keine sichtbaren Zeilen, d.h. es gibt auch nix zu scannen.
' Da aber ein Lieferschein erzeugt werden kann, zeigen wir jetzt alles an,
' und fragen nach dem Laden ob der letzte LS direkt erstellt werden soll
ShowAllArticles()
ASK_FOR_DELNOTE = True
End If
Grid.InitUserGrid
Grid.Header
Grid.Clear(1002)
Grid.IsRedraw = False
' Zähler für Grid
' Wird immer hoch gezählt bei Grid.AddLine
GridLineCounter = 1
' Zähler für Datenstruktur
' Wird in JEDEM Durchlauf hochgezählt
OrderArrayIndex = 0
Do
' Speicher für benutzerdefinierte Felder im Grid
' (495,0) - Menge Gesamt
' (495,1) - Menge Gescannt
' (495,2) - Seriennummer
' (495,3) - Artikelnummer
' (495,4) - Bezeichnung
' (495,5) - Seriennummer Ja/Nein
' (495,6) - Spät Ausprägung Ja/Nein
' (495,7) - Interne Zeilennumemr
Dim AmountOrdered, AmountDelivered
AmountOrdered = Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex))
AmountDelivered = Cint(ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex))
ProductGroup = Cint(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex))
Amount = AmountOrdered - AmountDelivered
SalesMacro = ORDER_ARTICLE_DATA(INDEX_SALES_MACRO, OrderArrayIndex)
ArticleType = ORDER_ARTICLE_DATA(INDEX_ARTICLE_TYPE, OrderArrayIndex)
ChargeFlag = Cint(ORDER_ARTICLE_DATA(INDEX_CHARGE_FLAG, OrderArrayIndex))
IsLateShape = Cint(ORDER_ARTICLE_DATA(INDEX_IS_LATE_SHAPE, OrderArrayIndex))
ArticleNumber = ORDER_ARTICLE_DATA(INDEX_ARTICLE_NUMBER, OrderArrayIndex)
Description = ORDER_ARTICLE_DATA(INDEX_DESCRIPTION, OrderArrayIndex)
IsVisible = ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex)
LineNumber = CInt(ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex))
IsSerialNumber = CInt(ORDER_ARTICLE_DATA(INDEX_IS_SERIAL_NUMBER, OrderArrayIndex))
MacroFlag = CInt(ORDER_ARTICLE_DATA(INDEX_MACRO_FLAG, OrderArrayIndex))
MacroLineNumber = CInt(ORDER_ARTICLE_DATA(INDEX_MACRO_LINE_NUMBER, OrderArrayIndex))
If (IsVisible = True) Then
If ChargeFlag = 2 Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = 1
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = 0
ResetableFlag = 1
If MacroFlag = 2 Then
LineColor = COLOR_PACKAGE_RED
AddMacroLineNumberTokensToDuplicateArticles ArticleNumber, MacroLineNumber
Else
LineColor = COLOR_RED
End If
' GridLine Index der Duplikate-Struktur hinzufügen
AddGridLineIndexToDuplicateArticles ArticleNumber, GridLineCounter
ElseIf (CheckArticleGroupIsRelevant(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)) = False) OR AmountOrdered = 0 Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = Amount
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = Amount
ResetableFlag = 0
If MacroFlag = 2 Then
LineColor = COLOR_PACKAGE_GREEN
Else
LineColor = COLOR_GREEN
End If
ElseIf MacroFlag = 1 Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = Amount
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = 0
ResetableFlag = 0
LineColor = COLOR_BLUE
Else
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = Amount
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = 0
ResetableFlag = 1
If MacroFlag = 2 Then
LineColor = COLOR_PACKAGE_RED
AddMacroLineNumberTokensToDuplicateArticles ArticleNumber, MacroLineNumber
Else
LineColor = COLOR_RED
End If
' GridLine Index der Duplikate-Struktur hinzufügen
AddGridLineIndexToDuplicateArticles ArticleNumber, GridLineCounter
End If
CWLCurrentWindow.ActiveWindow.Vars.Value(495,2) = ""
CWLCurrentWindow.ActiveWindow.Vars.Value(495,3) = ArticleNumber
CWLCurrentWindow.ActiveWindow.Vars.Value(495,4) = Description
CWLCurrentWindow.ActiveWindow.Vars.Value(495,5) = IsSerialNumber
CWLCurrentWindow.ActiveWindow.Vars.Value(495,6) = IsLateShape
CWLCurrentWindow.ActiveWindow.Vars.Value(495,7) = LineNumber
CWLCurrentWindow.ActiveWindow.Vars.Value(495,8) = GridLineCounter
CWLCurrentWindow.ActiveWindow.Vars.Value(495,9) = ResetableFlag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,10) = MacroFlag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,11) = MacroLineNumber
' Neue Grid-Zeile schreiben
Grid.AddLine
' Zeilenfarbe mit ROT vorbelegen
Grid.SetLineColor GridLineCounter, LineColor
GridLineCounter = GridLineCounter + 1
End If
OrderArrayIndex = OrderArrayIndex + 1
Loop While OrderArrayIndex < (UBound(ORDER_ARTICLE_DATA, 2) + 1)
LoadOrder = True
Grid.IsRedraw = True
End Function
' Schaltet alle nicht sichtbaren Felder auf sichtbar um
Sub ShowAllArticles
For OrderArrayIndex = 0 to UBound(ORDER_ARTICLE_DATA, 2)
If (ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = False And ORDER_ARTICLE_DATA(INDEX_IS_OPEN, OrderArrayIndex) = True) Then
ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True
End If
Next
End Sub
' Gibt True zurück, wenn es min. 1 sichtbare Zeile gibt
Function ExistVisibleRows
ExistVisibleRows = False
For OrderArrayIndex = 0 to UBound(ORDER_ARTICLE_DATA, 2)
If (ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True) Then
ExistVisibleRows = True
Exit For
End If
Next
End Function

112
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/ResetValuesByLineIndex.vbm Normal file
View File

@@ -0,0 +1,112 @@
' ResetValuesByLineIndex(LineIndex : INT)
' ----------------------------------------------------------------------------
' Setzt die Werte in einer bestimmten Zeile auf ihre
' Ausgangswerte zurück.
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 15.03.2021 / MP
' Version Date / Editor: 15.03.2021 / MP
' Version Number: 3.0.0.1
Sub ResetValues(GridLineIndexToReset)
Set myWin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = myWin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount
If GridIndex = GridLineIndexToReset Then
Grid.SetCellValue GridIndex, COLUMN_SCANNED, 0
Grid.SetCellValue GridIndex, COLUMN_SERIALNUMBER, ""
If (Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG) = 2) Then
Grid.SetLineColor GridIndex, COLOR_PACKAGE_RED
Else
Grid.SetLineColor GridIndex, COLOR_RED
End If
Exit For
End If
Next
End Sub
Sub ResetValuesByMacroLineNumber(MacroArticleLineNumber)
Set myWin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = myWin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount
MacroLineNumber = Cint(Grid.GetCellValue(GridIndex, COLUMN_MACRO_LINE_NUMBER))
If MacroLineNumber = MacroArticleLineNumber Then
Grid.SetCellValue GridIndex, COLUMN_SCANNED, 0
Grid.SetCellValue GridIndex, COLUMN_SERIALNUMBER, ""
Grid.SetLineColor GridIndex, COLOR_PACKAGE_RED
End If
Next
End Sub
Sub ResetValuesByLineIndex(LineIndex)
Set myWin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = myWin.Controls.Item(GRID_ID).Grid
If (Grid.LineCount <= 0) Then
MsgBox "Bitte scannen Sie zuerst eine Auftragsnummer!", vbOKOnly + vbInformation, DEFAULT_TITLE
Exit Sub
End If
Dim LineIndexToReset : LineIndexToReset = 0
If (LineIndex = -1) Then
InputBoxHeaderText = "Zeile zurücksetzen"
If (Grid.LineCount = 1) Then
InputBoxText = "Zeilennummer:"
InputBoxDefault = "1"
Else
InputBoxText = "Zeilennummer (Zeile [1 - " & Grid.LineCount & "]):"
InputBoxDefault = "0"
End If
LineIndexInputBox = InputBox(InputBoxText, InputBoxHeaderText, InputBoxDefault)
Select Case True
Case IsEmpty(LineIndexInputBox)
' Abbruch der Box
Exit Sub
Case "" = Trim(LineIndexInputBox)
' Kein Wert eingegeben = Abbruch
Exit Sub
Case Else
' Wert eingegeben und OK geklickt
If Len(LineIndexInputBox) > 0 Then
LineIndexToReset = Cint(LineIndexInputBox)
Else
LineIndexToReset = 0
End If
End Select
Else
LineIndexToReset = LineIndex
End If
If (LineIndexToReset <= 0 OR LineIndexToReset > Grid.LineCount) Then
MsgBox "Keine gültige Zeile ausgewählt!", vbOKOnly + vbInformation, DEFAULT_TITLE
ElseIf (Grid.GetCellValue(LineIndexToReset, COLUMN_RESETABLE_FLAG) = 0) Then
MsgBox "Die Zeile [" & LineIndexToReset & "] ist nicht änderbar!", vbOKOnly + vbInformation, DEFAULT_TITLE
ElseIf (LineIndexToReset > 0 And LineIndexToReset <= Grid.LineCount) Then
Answer = MsgBox("Sollen die Werte in Zeile [" & LineIndexToReset & "] zurückgesetzt werden?", vbYesno + vbQuestion, DEFAULT_TITLE)
If Answer = vbYes Then
ResetValues LineIndexToReset
CURRENT_GRID_LINE_INDEX = 0
End If
Else
MsgBox "Diese Zeilennummer gibt es nicht!"
End If
End Sub

30
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/SerialNumberExists.vbm Normal file
View File

@@ -0,0 +1,30 @@
' SerialNumberExists(SerialNumber : String)
' ----------------------------------------------------------------------------
' Prüft, ob die übergebene Seriennummer bereits gescannt wurde
'
' Returns: SerialNumberExists : Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 25.09.2020 / JJ
' Version Date / Editor: 25.09.2020 / JJ
' Version Number: 1.0.0.0
Function SerialNumberExists(SerialNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
SerialNumberExists = False
For GridIndex = 1 To Grid.LineCount
CurrentSerialNumber = Grid.GetCellValue(GridIndex, COLUMN_SERIALNUMBER)
If SerialNumber = CurrentSerialNumber Then
SerialNumberExists = True
Exit For
End If
Next
End Function

27
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/SetAmount.vbm Normal file
View File

@@ -0,0 +1,27 @@
' SetAmount(Amount: Integer)
' ----------------------------------------------------------------------------
' Setzt eingegebene Menge in das Mengenfeld ein
' - Überschreibt Menge beim ersten Eintrag, danach
' wird die Zahl angehängt
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 25.09.2020 / JJ
' Version Date / Editor: 25.09.2020 / JJ
' Version Number: 1.0.0.0
Sub SetAmount(Amount)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
If amountBox.Contents = AMOUNT_PLACEHOLDER Then
amountBox.Contents = Cstr(Amount)
Else
amountBox.Contents = amountBox.Contents & Cstr(Amount)
End If
End Sub

32
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/SetDebugMode.vbm Normal file
View File

@@ -0,0 +1,32 @@
' SetDebugMode()
' ----------------------------------------------------------------------------
' Zeigt je nach DEBUG-Mode die nicht sichtbaren Spalten
' im Grid an oder nicht, je nach DEBUG_ON-Einstellung.
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.04.2021 / MP
' Version Date / Editor: 01.04.2021 / MP
' Version Number: 3.0.0.2
Sub SetDebugMode()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' Unsichtbare Spalten anzeigen im DEBUG-Modus
Dim invisibleColWidth : invisibleColWidth = 0
If DEBUG_ON = True Then
invisibleColWidth = 5
End If
Grid.SetColumnWidth COLUMN_LINE_NUMBER, invisibleColWidth
Grid.SetColumnWidth COLUMN_RESETABLE_FLAG, invisibleColWidth
Grid.SetColumnWidth COLUMN_MACRO_FLAG, invisibleColWidth
Grid.SetColumnWidth COLUMN_MACRO_LINE_NUMBER, invisibleColWidth
End Sub

87
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/SetupWindow.vbm Normal file
View File

@@ -0,0 +1,87 @@
' SetupWindow()
' ----------------------------------------------------------------------------
' Definiert die Spalten des Grids und initialisiert Felder
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.09.2020 / JJ
' Version Date / Editor: 30.03.2021 / MP
' Version Number: 3.0.0.1
Sub SetupWindow()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' Speicher für benutzerdefinierte Felder
' (495,0) - Menge Gesamt
' (495,1) - Menge Gescannt
' (495,2) - Seriennummer
' (495,3) - Artikelnummer
' (495,4) - Bezeichnung
' (495,5) - Chargen-/Identflag
' (495,6) - Spät ausgeprägt bzw. Regex vorhanden
' (495,7) - Interne Zeilennummer aus Auftrag
' (495,8) - Sichtbare Zeilennummer im Grid
' (495,9) - Zeile darf resettet werden (J/N)
' (495,10) - Makro Flag (0 - Default / 1 = Macro-Artikel / 2 = Sub-Macro-Artikel)
' (495,11) - Makro Index, Zeilennummer des übergeordneten Makro-Artikels
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 0, "2", 10
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 1, "2", 10
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 2, "1", 20
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 3, "1", 20
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 4, "1", 60
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 5, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 6, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 7, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 8, "2", 4
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 9, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 10, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 11, "2", 3
Grid.InitUserGrid
Grid.IsRedraw = False
Grid.Header
If COLUMNS_CREATED = False Then
COLUMN_GRID_LINE_INDEX = Grid.AddColumn("#", "T22,Zeilenindex", "z", "V", 0, 495, 8, 4, sizeflag+hideflag)
COLUMN_ARTICLENUMBER = Grid.AddColumn("Artikelnummer", "T21,Artikelnummer", "l", "V", 0, 495, 3, 15, sizeflag+hideflag)
COLUMN_DESCRIPTION = Grid.AddColumn("Bezeichnung", "T21,Bezeichnung", "l", "V", 0, 495, 4, 37, sizeflag+hideflag)
COLUMN_TOTAL = Grid.AddColumn("Gesamt", "T22,Gesamt", "z", "V", 0, 495, 0, 10, sizeflag+hideflag)
COLUMN_SCANNED = Grid.AddColumn("Gescannt", "T22,Gescannt", "z", "V", 0, 495, 1, 10, sizeflag+hideflag)
COLUMN_SERIALNUMBER = Grid.AddColumn("Seriennummer", "T21,Seriennummer", "l", "V", 0, 495, 2, 20, sizeflag+hideflag)
COLUMN_CHARGE_FLAG = Grid.AddColumn("S/N?", "T17,Seriennummer", "l", "V", 0, 495, 5, 6, sizeflag+hideflag)
COLUMN_LATE_SHAPE = Grid.AddColumn("Auspr?", "T17,Spaetausgepr.", "l", "V", 0, 495, 6, 6, sizeflag+hideflag)
COLUMN_LINE_NUMBER = Grid.AddColumn("LN", "T22,Zeilennummer", "r", "V", 0, 495, 7, 0, 0) ' nicht sichtbar
COLUMN_RESETABLE_FLAG = Grid.AddColumn("RF", "T22,ResetableFlag", "r", "V", 0, 495, 9, 0, 0) ' nicht sichtbar
COLUMN_MACRO_FLAG = Grid.AddColumn("MF", "T22,MacroFlag", "r", "V", 0, 495, 10, 0, 0) ' nicht sichtbar
COLUMN_MACRO_LINE_NUMBER = Grid.AddColumn("MLN", "T22,MacroZeilenr", "r", "V", 0, 495, 11, 0, 0) ' nicht sichtbar
COLUMNS_CREATED = True
End If
Grid.IsRedraw = True
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
amountBox.Contents = AMOUNT_PLACEHOLDER
Set articleBox = mywin.Controls.Item(ARTICLE_INPUT)
articleBox.Contents = ""
' Merker für Resetbutton
CURRENT_GRID_LINE_INDEX = 0
PRINT_DOCUMENT_AFTER_COMPLETION = True
SetLabelText TEXT_CONFIG_INFO, 495, 71, ""
' Arrays reinitialisieren
Redim ORDER_ARTICLE_DATA(MAX_ORDER_COLUMN_COUNT, -1)
Redim MACRO_ARTICLE_LIST(MAX_MACRO_COLUMN_COUNT, -1)
Redim DUPL_ARTICLE_LIST(MAX_DUPL_COLUMN_COUNT, -1)
MacroCommands.MSetFieldFocus WINDOW_ID, ORDER_INPUT
End Sub

62
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/TestArticleHasSerialNumberRegex.vbm Normal file
View File

@@ -0,0 +1,62 @@
' TestArticleHasSerialNumberRegex(Identifier: String)
' ----------------------------------------------------------------------------
' Findet Artikelnummer anhand von versch. Kriterien
' - Artikel-Nummer, Alternative Artikel-Nummer, EAN-Code, Seriennummer
' - Gibt die Zeile im Grid zurück in der Artikel das erste Mal gefunden wurde
'
' Returns: TestArticleHasSerialNumberRegex : Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 25.09.2020 / JJ
' Version Date / Editor: 25.09.2020 / JJ
' Version Number: 1.0.0.0
Function TestArticleHasSerialNumberRegex(Identifier)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
If DEBUG_ON = True Then
AddDebugLine "Testing for Regex in Identifier: " & Identifier
ShowDebugBox "TestArticleHasSerialNumberRegex"
End If
SQL = ""
' Artikelnummer / EAN-Code / Alternative Artikelnummer
SQL = SQL & "((C002 = '" & Identifier & "') Or (C075 = '" & Identifier & "') Or (C114 = '" & Identifier & "')) AND "
' Serienummer-Regex muss vorhanden sein
SQL = SQL & "(C222 IS NOT NULL) AND "
' Artikel darf nicht inaktiv sein
SQL = SQL & "(c038 IS NULL) "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
If DEBUG_ON = True Then
AddDebugLine "SQL: " & SQL
ShowDebugBox "TestArticleHasSerialNumberRegex"
End If
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for SerialNumber-Regex by ArticleNumber " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "TestArticleHasSerialNumberRegex"
End If
If Result.RowCount > 0 Then
TestArticleHasSerialNumberRegex = True
Else
TestArticleHasSerialNumberRegex = False
End If
End Function

37
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/TestHasFreeArticleRow.vbm Normal file
View File

@@ -0,0 +1,37 @@
' TestHasFreeArticleRow(ArticleNumber : String)
' ----------------------------------------------------------------------------
' Sucht die nächste freie Zeile für eine gescannte Seriennummer
'
' Returns: TestHasFreeArticleRow : Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 25.09.2020 / JJ
' Version Date / Editor: 25.09.2020 / JJ
' Version Number: 1.0.0.0
Function TestHasFreeArticleRow(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim NextFreeRow : NextFreeRow = False
If DEBUG_ON = True Then
AddDebugLine "Getting next free row for Article: " & ArticleNumber
ShowDebugBox "TestHasFreeArticleRow"
End If
For GridIndex = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(GridIndex, COLUMN_ARTICLENUMBER)
CurrentSerialNumber = Grid.GetCellValue(GridIndex, COLUMN_SERIALNUMBER)
If UCase(ArticleNumber) = UCase(CurrentArticleNumber) And Len(CurrentSerialNumber) = 0 Then
NextFreeRow = True
Exit For
End If
Next
TestHasFreeArticleRow = NextFreeRow
End Function

43
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/TestIsWebserviceResponseSuccessful.vbm Normal file
View File

@@ -0,0 +1,43 @@
' TestIsWebserviceResponseSuccessful(XmlString : String)
' ----------------------------------------------------------------------------
' Prüft, ob im WebService Result, ein Success enthalten ist
'
' Returns: TestIsWebserviceResponseSuccessful : Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 23.10.2020 / JJ
' Version Date / Editor: 23.10.2020 / JJ
' Version Number: 1.0.0.0
Function TestIsWebserviceResponseSuccessful(XmlString)
' Check if XmlString is actually a xml string
If InStr(XmlString, "<?xml") = 1 Then
Set Doc = CreateObject("MSXML2.DOMDocument")
Doc.loadXML(XmlString)
Set Nodes = Doc.SelectNodes("MESOWebServiceResult/ResultDetails")
Set OverallSuccess = Doc.SelectSingleNode("MESOWebServiceResult/OverallSuccess")
If OverallSuccess.Text = "true" Then
Dim IsSuccess : IsSuccess = True
For Each Node in Nodes
Set Success = Node.SelectSingleNode("Success")
If Success.Text <> "true" Then
IsSuccess = False
End If
Next
TestIsWebserviceResponseSuccessful = IsSuccess
Else
TestIsWebserviceResponseSuccessful = False
End If
Else
TestIsWebserviceResponseSuccessful = False
End If
End Function

65
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/TransferGridData.vbm Normal file
View File

@@ -0,0 +1,65 @@
' TransferGridData()
' ----------------------------------------------------------------------------
' Überführt die Gescannten Daten aus dem Grid in die Datenstruktur
'
' Returns: TransferGridData: Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.09.2021 / JJ
' Version Date / Editor: 25.03.2021 / MP
' Version Number: 3.0.0.1
Function TransferGridData()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount: Do
Total = Cint(Grid.GetCellValue(GridIndex, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(GridIndex, COLUMN_SCANNED))
ChargeFlag = Cint(Grid.GetCellValue(GridIndex, COLUMN_CHARGE_FLAG)) ' Checkbox-Werte = 0 oder 1
' Zeilennummer aus Auftrag
LineNumber = Cint(Grid.GetCellValue(GridIndex, COLUMN_LINE_NUMBER))
SerialNumber = Grid.GetCellValue(GridIndex, COLUMN_SERIALNUMBER)
MacroFlag = Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG)
If Scanned = 0 Then
Exit Do
End If
For OrderArrayIndex = 0 To Ubound(ORDER_ARTICLE_DATA, 2)
If ORDER_ARTICLE_DATA(INDEX_IS_VISIBLE, OrderArrayIndex) = True Then
If ORDER_ARTICLE_DATA(INDEX_LINE_NUMBER, OrderArrayIndex) = LineNumber Then
If MacroFlag = 1 Then
For MacroArrayIndex = 0 To UBound(MACRO_ARTICLE_LIST)
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = LineNumber) Then
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_COMPLETE, MacroArrayIndex) = True) Then
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_REMAINING, MacroArrayIndex)
Else
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex)
End If
Exit For
End If
Next
ElseIf ChargeFlag = 1 And Len(ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex)) = 0 Then
ORDER_ARTICLE_DATA(INDEX_SERIAL_NUMBER, OrderArrayIndex) = SerialNumber
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = Scanned
Exit For
ElseIf ChargeFlag = 0 Then
ORDER_ARTICLE_DATA(INDEX_AMOUNT_SCANNED, OrderArrayIndex) = Scanned
Exit For
End If
End If
End If
Next
Loop While False: Next
TransferGridData = True
End Function

42
archive/Packtisch Modul/Packtisch 3.0.0.4 - Setup/Modules/Packtisch_3_0/TransferMacroData.vbm Normal file
View File

@@ -0,0 +1,42 @@
' TransferMacroData()
' ----------------------------------------------------------------------------
' Überführt die Daten aus dem Macro-Array zurück ins Grid
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 08.03.2021 / MP
' Version Date / Editor: 08.03.2021 / MP
' Version Number: 3.0.0.0
Sub TransferMacroData()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
For GridIndex = 1 To Grid.LineCount: Do
MacroFlag = Cint(Grid.GetCellValue(GridIndex, COLUMN_MACRO_FLAG))
If MacroFlag = 1 Then
LineNumber = Cint(Grid.GetCellValue(GridIndex, COLUMN_LINE_NUMBER))
For MacroArrayIndex = 0 To UBound(MACRO_ARTICLE_LIST, 2)
' Wenn die Menge in COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED > 0 ist,
' dann muss dieser Wert ins Grid zurück geschrieben werden.
If (MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_LINE_NUMBER, MacroArrayIndex) = LineNumber) And _
(MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex) > 0) Then
Grid.SetCellValue GridIndex, COLUMN_SCANNED, MACRO_ARTICLE_LIST(COLUMN_MACRO_ARTICLE_AMOUNT_COMPLETED, MacroArrayIndex)
Exit For
End If
Next
Else
' Continue
Exit Do
End If
Loop While False: Next
End Sub

Some files were not shown because too many files have changed in this diff Show More