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

237
archive/Packtisch Modul/Packtisch 3.0.0.6 - Setup (in Progress...)/Modules/Packtisch_3_0/ArticleExists.vbm Normal file
View File

@@ -0,0 +1,237 @@
' 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: 13.12.2021 / MP
' Version Number: 3.0.0.6
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
' ===================== SERIENNUMMER =====================
' Zuerst prüfen wir, ob es ein Seriennummerartikel ist
Set ResultSeriennummer = GetSeriennummerRow(Identifier)
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
' Default: ART_REGEX_FLDBEZ = C222
SerialNumberPattern = ResultMainArticle.Value(ART_REGEX_FLDBEZ)
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
' ===================== ARTIKEL NUMMER / EAN-CODE =====================
' Wenn es kein Ausprägeartikel ist, suchen wir im Artikelstamm
Set Result = GetArticleRow(Identifier)
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")
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
Function GetSeriennummerRow(Identifier)
Set GetSeriennummerRow = Nothing
If Len(Identifier) > 0 Then
Set Conn = CWLStart.Connection
SQL = ""
SQL = SQL & " SELECT TOP 1 C002, C011, C068 "
SQL = SQL & " FROM T024 (NOLOCK) "
SQL = SQL & " WHERE C068 = '" & Identifier & "' "
SQL = SQL & " AND c038 IS NULL " ' Nur aktive Artikel
SQL = SQL & SQLQuery_BasicWhere
Set GetSeriennummerRow = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for Article by Article serial number " & vbNewline
AddDebugLine "Result Columns: " & GetSeriennummerRow
AddDebugLine "Result Rows: " & GetSeriennummerRow.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists - GetSeriennummerRow"
End If
End If
End Function
' Ruft Daten aus der Tabelle t024 ab, für Artikel OHNE Ausprägung
Function GetArticleRow(Identifier)
Set GetArticleRow = Nothing
If Len(Identifier) > 0 Then
Set Conn = CWLStart.Connection
SQL = ""
SQL = SQL & " SELECT TOP 1 C002, C011 "
SQL = SQL & " FROM T024 (NOLOCK) "
SQL = SQL & " (C002 = '" & Identifier & "' OR C075 = '" & Identifier & "' OR C114 = '" & Identifier & "' OR C115 = '" & Identifier & "') "
SQL = SQL & " AND c038 IS NULL " ' Nur aktive Artikel
SQL = SQL & SQLQuery_BasicWhere
Set GetArticleRow = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for Article by ArticleNo/EAN-Code.. " & vbNewline & vbNewline
AddDebugLine "Result Columns: " & GetArticleRow & vbNewline
AddDebugLine "Result Rows: " & GetArticleRow.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists - GetArticleRow"
End If
End If
End Function

82
archive/Packtisch Modul/Packtisch 3.0.0.6 - Setup (in Progress...)/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.6 - Setup (in Progress...)/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.6 - Setup (in Progress...)/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

300
archive/Packtisch Modul/Packtisch 3.0.0.6 - Setup (in Progress...)/Modules/Packtisch_3_0/CompleteOrder.vbm Normal file
View File

@@ -0,0 +1,300 @@
' 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: 17.08.2021 / JJ/MP
' Version Number: 3.0.0.5
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)
' Sonderfall Artikel mit negativen Mengen
If (ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex) - ORDER_ARTICLE_DATA(INDEX_AMOUNT_DELIVERED, OrderArrayIndex)) < 0 Then
AmountScanned = ORDER_ARTICLE_DATA(INDEX_AMOUNT_ORDERED, OrderArrayIndex)
IsOpen = True
End If
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.6 - Setup (in Progress...)/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.6 - Setup (in Progress...)/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.6 - Setup (in Progress...)/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.6 - Setup (in Progress...)/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.6 - Setup (in Progress...)/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.6 - Setup (in Progress...)/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.6 - Setup (in Progress...)/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.6 - Setup (in Progress...)/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: 20.07.2021 / MP
' Version Number: 3.0.0.5
Function GetSQL(OrderNumber)
Dim SQL : SQL = ""
SQL = SQL & " SELECT t2.*, t3.c037 c2137, t3.c079 c2179, t3." & ART_REGEX_FLDBEZ & " 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)" --> wegen späten Ausprägungen brauchen wir alle Zeilen
' 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.6 - Setup (in Progress...)/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.6 - Setup (in Progress...)/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.6 - Setup (in Progress...)/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.6 - Setup (in Progress...)/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.6 - Setup (in Progress...)/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.6 - Setup (in Progress...)/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: 20.07.2021 / MP
' Version Number: 3.0.0.5
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 (Default: C222) muss vorhanden sein
SQL = SQL & "(" & ART_REGEX_FLDBEZ & " 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.6 - Setup (in Progress...)/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.6 - Setup (in Progress...)/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.6 - Setup (in Progress...)/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.6 - Setup (in Progress...)/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.6 - Setup (in Progress...)/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

51
archive/Packtisch Modul/Packtisch 3.0.0.6 - Setup (in Progress...)/Modules/Packtisch_3_0/UpdateDeliveryNote.vbm Normal file
View File

@@ -0,0 +1,51 @@
' UpdateDeliveryNote(OrderNumber: String)
' ----------------------------------------------------------------------------
' Füllt zusätzliche Felder in der Tabelle t025 (Belegkopf)
' - User ID (FLD_BENUTZERNUMMER_PACKTISCH)
' - Datum und Uhrzeit der LS-Erzeugung (FLD_ERSTELLDATUM_PACKTISCH)
' - Name des Computers an dem der Packtisch läuft (FLD_COMPUTERNAME_PACKTISCH)
' - Packtischversion (FLD_VERSION_PACKTISCH)
'
' 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: 23.06.2021 / MP
' Version Number: 3.0.0.4
Sub UpdateDeliveryNote(OrderNumber)
Err.Clear
If USE_ADDITIONAL_DBFIELDS = False Then
Exit Sub
End If
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 SET "
SQL = SQL & FLD_BENUTZERNUMMER_PACKTISCH & " = " & UserNumber & ", "
SQL = SQL & FLD_ERSTELLDATUM_PACKTISCH & " = '" & DateString & " " & TimeString & "', "
SQL = SQL & FLD_COMPUTERNAME_PACKTISCH & " = '" & ComputerName & "', "
SQL = SQL & FLD_VERSION_PACKTISCH & " = '" & 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 Sub

73
archive/Packtisch Modul/Packtisch 3.0.0.6 - Setup (in Progress...)/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: 24.06.2021 / MP
' Version Number: 3.0.0.4
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 aus den EXCLUDED_ARTICLEGROUPS ja bereits vollständig initialisiert werden.
If CheckArticleGroupIsRelevant(ORDER_ARTICLE_DATA(INDEX_ARTICLE_GROUP, OrderArrayIndex)) = False 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