ÿÿCHHVBScriptEngineÿþÿ (Allgemein)ÿþÿ(Deklarationen)ÿþÿ'(Deklarationen) ÿþÿÿºr ' CONVERT-WINLINE_DOCUMENT_ORDER_TO_DELIVERYN ' ---------------------------------------------------------------------------- ' Wird vom Packtisch-Modul aufgerufen, wenn der Lieferschein ein oder mehrere ' Spät-Ausprägungen enthält. Diese können nicht per WebService erzeugt werden. ' ' Ergebnis des Macros: Ein (Teil-)Lieferschein-Beleg ' ' 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.07.2020 / MK ' Version Date / Editor: 08.09.2021 / MP ' Version Number: 3.0.0.5 On Error Resume Next '########## Set Customizable Constants ######### ' EXIM Datenbankname SQLDatabase_EXIM = "[EXIM_MEDACOM]" ' Zusatzfelder im Mandantenstamm (Feldnummern beginnen mit 200 für das 1. Feld) ' Module-Pfad MDFLDNO_MODULE_PATH = 209 ' Default: 209 = 10. MD-Zusatzfeld ' Zusatzfelder im Artikelstamm (Feldnummern beginnen mit 200 für das 1. Feld) ARTFLDNO_SN_REGEX = 222 ' Default: 222 = 22. Artikel-Zusatzfeld '############################################### '########## get parameter ######### 'Necessary to get parameters in the code. Do not change! params = MParameters 'Parameter 1 to 19 are reserved by WinLine interal function 'First call parameter = control debug mode paramDebugMode = params(20) 'Second call parameter = Belegnummer des Auftrags paramDocNumber = params(21) 'Third call parameter = Kontonummer paramAccountNumber = params(22) 'Fourth call parameter = Laufnummer paramRunningNumber = params(23) '################################## '########## set constants ######### 'Get current MandantorNr, like "500M". WinLineCurrentMandatorNr = CWLStart.CurrentCompany.Nr 'Get current meso year, like 1440 ((2020 - 1900) * 12 = 1440). WinLineCurrentYear = CWLStart.CurrentCompany.CompanyYear 'Get current username like "meso". WinLineCurrentUser = CWLStart.CurrentUser.Account 'Get current WinLine exe path WinLineAppPath = CWLStart.Application.AppPath 'Get current date and time. Timestamp = Now 'Basic SQL where for mandator and current mesoyear SQLQuery_BasicWhere = " and (mesocomp = '" & WinLineCurrentMandatorNr &"') and (mesoyear = " & WinLineCurrentYear & ")" 'Order SQL where for mandator and current and previous mesoyear SQLQuery_OrderWhere = " and (mesocomp = '" & WinLineCurrentMandatorNr &"') and (mesoyear = " & WinLineCurrentYear & " or mesoyear = " & (WinLineCurrentYear - 12) & ")" 'Prepare Array for modules to load (Arrays are zero based!) Modules = Array("AddDebugLine","ShowDebugBox","GetWinLineProductInfoByProductNumber","GetWinLineDocDeliveryNoteByUnsplittedProducts","ShowWinLineMandatorAndWinLineYear","ShowWinLineDocOverview","ShowWinLineDocForEditing","SwitchWinLineGoToMacros") '################################## '########## set variables ######### 'Debug (Debug Meldungen anzeigen) DEBUG_ON = False DEBUG_MESSAGE = "" DebugMode = paramDebugMode 'Set path for Digital Data Modules. Default: Mandator additional field 10 (IF-ModulPfad-DigitalData) = CWLStart.CurrentCompany.Value(209) ModuleDefaultSourcePath = CWLStart.CurrentCompany.Value(MDFLDNO_MODULE_PATH) DocNumber = paramDocNumber AccountNumber = paramAccountNumber RunningNumber = paramRunningNumber 'Build unique key for the doc DocAccountAndRunningNr = paramAccountNumber & "-" & paramRunningNumber 'Set SQL Table and Query for DocHead. Default: "T025" SQLTable_DocHead = "[T025]" SQLQuery_DocHead = "c000 = '" & DocAccountAndRunningNr & "'" & SQLQuery_OrderWhere 'Set SQL Table and Query for DocBody. Default: "T026" 'c055 = column for "Flag Hauptartikel mit Charge/Ident" SQLTable_DocMid = "[T026]" SQLQuery_DocMid = "c000 LIKE '" & DocAccountAndRunningNr & "-%'" & " and [c055] in (0, 2, 12)" & SQLQuery_OrderWhere DocWindowID = 245 DocWindowGridID = 300 DocWindowGridProductColumn = 2 DocWindowGridLineNumberColumn = 81 DocWindowGridAmountColumn = 4 DocShapeWindowID = 251 DocShapeWindowGridID = 100 DocShapeWindowGridIdentColumn = 5 DocShapeWindowGridAmountColumn = 6 DocShapeWindowGridBelegColumn = 50 SQLTable_EXIMHead = SQLDatabase_EXIM & ".[dbo].[IM_Beleg_PacktischLieferschein_VK_Kopf]" SQLQuery_EXIMHead = "SELECT TOP 1 BELEGKEY FROM " & SQLTable_EXIMHead & " (NOLOCK) WHERE [Auftragsnummer] = '"& DocNumber &"' ORDER BY [BELEGKEY] DESC" SQLTable_EXIMMiddle = SQLDatabase_EXIM & ".[dbo].[IM_Beleg_PacktischLieferschein_VK_Mitte]" SQLTemplate_EXIMMiddleCount = "" SQLTemplate_EXIMMiddleCount = SQLTemplate_EXIMMiddleCount & "SELECT count(BELEGKEY) As [c999] " SQLTemplate_EXIMMiddleCount = SQLTemplate_EXIMMiddleCount & "FROM " & SQLTable_EXIMMiddle & " (NOLOCK) " SQLTemplate_EXIMMiddleCount = SQLTemplate_EXIMMiddleCount & "WHERE [Zeilennummer] Is Not Null And BELEGKEY = '%SQLResult_Belegkey%' and [Hauptartikelnummer] = '%ProductNumber%' " SQLTemplate_EXIMMiddle = "" SQLTemplate_EXIMMiddle = SQLTemplate_EXIMMiddle & "SELECT [ChargeIdentnummer], [Mengegeliefert], [Lagerort], [Einzelpreis] " SQLTemplate_EXIMMiddle = SQLTemplate_EXIMMiddle & "FROM " & SQLTable_EXIMMiddle & " (NOLOCK) " SQLTemplate_EXIMMiddle = SQLTemplate_EXIMMiddle & "WHERE BELEGKEY = '%SQLResult_Belegkey%' and [Hauptartikelnummer] = '%ProductNumber%' " ' REGEX-Feld im Artikelstamm für Späte Ausprägungen ART_REGEX_FLDBEZ = "C" & ARTFLDNO_SN_REGEX '################################## '########## functions and subs ######### 'Function to load VBS modules Public Function LoadVBSModule(VBSModuleParams) 'SYNOPSIS 'Function will load external - additional - VBS Modules into current Script. 'DESCRIPTION 'By working With Modules, this Function Is necessary To load external Modul Functions into the current VB-Script. 'Call parameter must be an array, because VB-Script functions cannot handle optional Parameters. 'In develepment and Test Enviroment it is possible, to work with distributed Folders with different Modules. Therefor the Parameter '"VBSModuleParams(1)" (which is the ModuleOverrideSourcePath) and the preset Variable "ModuleDefaultSourcePath" are made for. 'After a successful Import of a Module, Function will Return True, otherwise a False. 'REQUIREMENT General 'VBS must be enabled 'REQUIREMENT Assembly '<NONE> 'REQUIREMENT Variables 'FSOModule, Module, ModuleCode 'REQUIREMENT Variables preSet '<NONE> 'REQUIREMENT Functions '<NONE> 'VERSION 'Number: 1.3.0.0 / Date: 25.08.2020 'PARAMETER VBSModuleParams(0) = ModuleName 'Give the Module Name, you want to load into the current VB-Script. 'PARAMETER VBSModuleParams(1) = ModuleOverrideSourcePath 'Optional Parameter. By giving the ModuleOverrideSourcePath, Function will not check other Paths for the Function you want to load. 'EXAMPLE 'Dim VBSModuleParams 'Redim VBSModuleParams(0) 'VBSModuleParams(0) = Module 'LoadVBSModule(VBSModuleParams) 'EXAMPLE 'Dim VBSModuleParams 'Redim VBSModuleParams(1) 'VBSModuleParams(0) = Module 'VBSModuleParams(1) = "D:\ScriptFiles\Modules" 'LoadVBSModule(VBSModuleParams) On Error Resume Next 'Clear Error Variable Err.Clear Dim FSOModule, Module, ModuleName, ModuleCode, ModulePath, WshShell, ModuleAutoSourcePath Set FSOModule = CreateObject("Scripting.FileSystemObject") 'How many parameters are given in the array If (UBound(VBSModuleParams) = 0) Then ModuleName = VBSModuleParams(0) If FSOModule.FolderExists(ModuleDefaultSourcePath) Then 'If global var is set, take it! ModulePath = ModuleDefaultSourcePath ELSE 'Getting the current dir, when ModuleDefaultSourcePath does not exist Set WshShell = CreateObject("WScript.Shell") ModuleAutoSourcePath = WshShell.CurrentDirectory 'By this parameter way the path is more variable ModulePath = ModuleAutoSourcePath & "\" & "Modules" If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then MSGBOX "Parameter1 = " & VBSModuleParams(0) & vbCrlf & _ "ModuleDefaultSourcePath = " & ModuleDefaultSourcePath,,"DEBUG Info: Parameter Values in Array - VBSModuleParams" End If End if ElseIf (UBound(VBSModuleParams) = 1) Then ModuleName = VBSModuleParams(0) ModulePath = VBSModuleParams(1) If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then MSGBOX "Parameter1 = " & VBSModuleParams(0) & vbCrlf & _ "Parameter2 = " & VBSModuleParams(1),,"DEBUG Info: Parameter Values in Array - VBSModuleParams" End If Else msgbox "Invalid function call!" & vbCrlf & _ "Please check the parameters!" & vbCrlf & _ "...then restart this Script!",vbExclamation ,"LoadVBSModule: Parameter Error!" End if 'Checking folder paths 'Check if given path is valid, if not create it If Not FSOModule.FolderExists(ModulePath) Then FSOModule.CreateFolder(ModulePath) msgbox "The ModulePath doesnt exist, trying to create!" & vbCrlf & _ "Please place your Modules there: " & vbCrlf & _ ModulePath & vbCrlf & vbCrlf & _ "...then restart this Script!",vbExclamation ,"LoadVBSModule: Modules / ModulePath is missing!" Else 'Clear Error Variable Err.Clear 'Building full module path and name ModuleFullName = ModulePath & "\" & Modulename & ".vbs" 'does the file exist? If Not FSOModule.FileExists(ModuleFullName) Then If Err.Number <> 0 Then MSGBOX "Error Code: "& Err.Number & vbCrlf & _ "Error Description: "& Err.Description,,"ERROR: Module does not exist! " Err.Clear LoadVBSModule = "False" End If Else 'Open file Set Module = FSOModule.OpenTextFile(ModuleFullName, 1) 'Get file content ModuleCode = Module.ReadAll 'Close file handle Module.Close 'Execute the file content ExecuteGlobal ModuleCode If Err.Number <> 0 Then MSGBOX "Error Code: "& Err.Number & vbCrlf & _ "Error Description: "& Err.Description,,"ERROR: Module cannot be loaded!" Err.Clear LoadVBSModule = "False" Else LoadVBSModule = "True" End If End If End If End Function 'LoadVBSModule '################################## '######### preparing part ######### 'Reset Error Var Err.Clear 'Display debug infos, if enabled If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then AddDebugLine "CurrentUser: " & CurrentUser AddDebugLine "MandatorNr: " & MandatorNr AddDebugLine "CurrentYear: " & CurrentYear AddDebugLine "Timestamp: " & Timestamp ShowDebugBox "Runtime Variables" CRLF = chr(13) & chr(10) msg = "Parameter:" & CRLF For i = 1 To Ubound(params) msg = msg & i & ".: " & params(i) & CRLF Next msgbox msg ,, "Macro Name: " & CWLMacro.MName End If Dim Module 'Load external Modules. For Each Module In Modules 'Create the array to pass in to our function Dim VBSModuleParams 'Call the subroutine with two arguments Redim VBSModuleParams(0) 'Change to 1, for 2 values VBSModuleParams(0) = Module 'VBSModuleParams(1) = "" LoadVBSModuleResult = LoadVBSModule(VBSModuleParams) If (LoadVBSModuleResult <> "True") Then 'Set WScript = CreateObject("WScript.Shell") MSGBOX "Module: " & Module & " was Not succesful been loaded!" & vbCrlf & _ "Please load the Module and try again, running this Function/Module!" & vbCrlf & _ "Exiting, because of this Issue." & vbCrlf & _ Err.Description, vbCritical, "DEBUG Info: Cannot load Module!" 'WScript.Quit = not possible in Winline enviroment End If Next 'end for each '################################## '########### main part ############ 'Check if necessary parameter are given If (paramDocNumber <> "") And (paramAccountNumber <> "") And (paramRunningNumber <> "") Then 'Query to get the relevant doc Set SQLResult_DocHead = CWLStart.CurrentCompany.SearchRecord(SQLTable_DocHead, SQLQuery_DocHead) If Err.Number <> 0 Then MSGBOX "Error Code: " & Err.Number & vbCrlf & _ "Error Description: " & Err.Description & vbCrlf & vbCrlf & _ "SQL-Table: " & SQLTable_DocHead & vbCrlf & _ "SQL-Query: " & SQLQuery_DocHead ,,"Error: Getting doc from DB Table!" Err.Clear Else If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then MSGBOX "SQL-Lines: " & SQLResult_DocHead.RowCount & vbCrlf & _ "SQL-Columns: " & SQLResult_DocHead & vbCrlf & vbCrlf & _ "SQL-Table: " & SQLTable_DocHead & vbCrlf & _ "SQL-Query: " & SQLQuery_DocHead,,"DEBUG - Info: Getting doc from DB Table!" End If If (SQLResult_DocHead.RowCount = 0) Or (SQLResult_DocHead.RowCount = -1) Then 'MSGBOX "Es wurden keine relevante Belege gefunden," & vbCrlf & _ ' "welche zu Aufträgen umgewandelt werden könnten.", vbOkonly+vbInformation, DEFAULT_TITLE & " - hat Langeweile!" Elseif (SQLResult_DocHead.RowCount > 1) Then Else 'Get count for main products on the doc Set SQLResult_DocMid = CWLStart.CurrentCompany.SearchRecord(SQLTable_DocMid, SQLQuery_DocMid) If Err.Number <> 0 Then MSGBOX "Error Code: " & Err.Number & vbCrlf & _ "Error Description: " & Err.Description & vbCrlf & vbCrlf & _ "SQL-Table: " & SQLTable_DocMid & vbCrlf & _ "SQL-Query: " & SQLQuery_DocMid ,,"Error: Getting doc from DB Table!" Err.Clear Else If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then MSGBOX "SQL-Lines: " & SQLResult_DocHead.RowCount & vbCrlf & _ "SQL-Columns: " & SQLResult_DocHead & vbCrlf & vbCrlf & _ "SQL-Table: " & SQLTable_DocMid & vbCrlf & _ "SQL-Query: " & SQLQuery_DocMid,,"DEBUG - Info: Getting doc from DB Table!" End If If (SQLResult_DocMid.RowCount = 0) Or (SQLResult_DocMid.RowCount = -1) Then 'MSGBOX "Es wurden keine relevanten Artikel auf dem Belege gefunden," & vbCrlf & _ ' "welche zu Aufträgen umgewandelt werden könnten.", vbOkonly+vbInformation, DEFAULT_TITLE & " - hat Langeweile!" Else 'Close all Windows MPushButton 45, 99, 0 MActivateWindow 510 'Call GUI to get into doc 'ShowWinLineMandatorAndWinLineYear WinLineCurrentMandatorNr, WinLineCurrentYear ShowWinLineDocOverview DocNumber, AccountNumber, RunningNumber ShowWinLineDocForEditing Set DocWindow = CWLStart.CurrentModule.Windows.Item(DocWindowID) Set DocWindowGrid = DocWindow.Controls.Item(DocWindowGridID).Grid ProductCount = SQLResult_DocMid.rowcount 'loop for every ProductNumber on the doc For ProductCounter = 1 To ProductCount ProductNumber = SQLResult_DocMid.value(1) 'loop to search for the productnumber in every doc line For DocLineCounter = 1 To DocWindowGrid.LineCount CellValue = DocWindowGrid.GetCellValue(DocLineCounter, DocWindowGridProductColumn) 'If productnumber was found in current line of the doc If (UCASE(CellValue) = UCASE(ProductNumber)) Then 'Query to get all Ident numbers for the current product Dim MConn, SQLResult_EXIMHead, SQLResult_EXIMMiddleCount, SQLResult_EXIMMiddle, ProductSerialNumber Set MConn = CWLStart.CurrentCompany.Connection Set WinLineProductInfo = GetWinLineProductInfoByProductNumber(ProductNumber, WinLineCurrentMandatorNr, WinLineCurrentYear) ProductType = WinLineProductInfo.value(39) 'c014 from v021 = Ausprägungsflag | 0 = Hauptartikel ohne Ident; 1 = Hauptartikel mit ident; 2 = Ausprägungsartikel ProductIdentType = WinLineProductInfo.value(ART_REGEX_FLDBEZ) 'c222 from v021 = Zusatzfeld Regex Prüfung (204 Feld in v21) 'Query to get unique key from head table, to find multiple lines in middle/pos table Set SQLResult_EXIMHead = MConn.Select(SQLQuery_EXIMHead) SQLResult_Belegkey = SQLResult_EXIMHead.value("BELEGKEY") 'muss noch rein: IF (SQLResult_Belegkey > 0) Then SQLQuery_EXIMMiddle = "" SQLQuery_EXIMMiddle = REPLACE(SQLTemplate_EXIMMiddle, "%SQLResult_Belegkey%", SQLResult_Belegkey) SQLQuery_EXIMMiddle = REPLACE(SQLQuery_EXIMMiddle, "%ProductNumber%", ProductNumber) Set SQLResult_EXIMMiddle = MConn.Select(SQLQuery_EXIMMiddle) ProductAmount = SQLResult_EXIMMiddle.value("Mengegeliefert") ProductShapeCode1 = SQLResult_EXIMMiddle.value("Auspr.1") ProductStorageID = SQLResult_EXIMMiddle.value("Lagerort") ProductEinzelpreis = SQLResult_EXIMMiddle.value("Einzelpreis") If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then msgbox "ProductCounter: " & ProductCounter & " of " & ProductCount & vbCrlf & _ "ProductNumber: " & ProductNumber & vbCrlf & _ "ProductType: " & ProductType & vbCrlf & _ "ProductShapeCode1: " & ProductShapeCode1 & vbCrlf & _ "ProductStorageID: " & ProductStorageID & vbCrlf & _ "ProductAmount: " & ProductAmount & vbCrlf & _ "ProductEinzelpreis: " & ProductEinzelpreis & vbCrlf & _ "Line: " & DocLineCounter & vbCrlf & _ "SQLResult_Belegkey: " & SQLResult_Belegkey & vbCrlf & vbCrlf & _ "SQL-Query: " & SQLQuery_EXIMMiddle & vbCrlf & _ "", vbOkayonly+vbInformation, "Loop of products" End If If ProductAmount > 0 Then 'Product without Ident number If (ProductType = 0) Then 'Fallback Value IF (ProductAmount = "") Then ProductAmount = 0 End if 'Set article amount MLastMessageResult = 1 MSetGridValue DocWindowID, 300, DocLineCounter, DocWindowGridAmountColumn, ProductAmount ' Set Einzelpreis (MP 040521) If Len(ProductEinzelpreis) > 0 Then MLastMessageResult = 1 MSetGridValue DocWindowID, 300, DocLineCounter, 5, ProductEinzelpreis End If 'Product with Ident number Elseif (ProductType = 1) Then 'Open Product Shape Window (Artikelausprägung) MLastMessageResult = 1 MGridDblClick DocWindowID, 300, DocLineCounter, 72 MLastMessageResult = 1 MSetFieldFocus DocShapeWindowID, 470 If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then msgbox "ProductIdentType: " & ProductIdentType End If 'Product without known Ident number If (ProductIdentType <> "") Then 'Get delivery notes For incoming goods, which were Not selected Set DeliveryNoteUnsplitted = GetWinLineDocDeliveryNoteByUnsplittedProducts(ProductNumber,WinLineCurrentMandatorNr,WinLineCurrentYear) DocDeliveryNoteUnsplittedProductAmount = DeliveryNoteUnsplitted.value("c995") If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then msgbox "DocDeliveryNoteUnsplittedProductAmount: " & DocDeliveryNoteUnsplittedProductAmount End If 'Set Template for new products ident numbers MLastMessageResult = 1 MComboSelchange DocShapeWindowID, 470, "Neuerfassung" MLastMessageResult = 1 MSetFieldValue DocShapeWindowID, 470, "Neuerfassung" 'Product with known Ident number Else 'Set Template for existing product ident numbers MLastMessageResult = 1 MComboSelchange DocShapeWindowID, 470, "Artikel mit Lagerstand" MLastMessageResult = 1 MSetFieldValue DocShapeWindowID, 470, "Artikel mit Lagerstand" End If 'Get many ident products are in the EXIM Table SQLQuery_EXIMMiddleCount = "" SQLQuery_EXIMMiddleCount = REPLACE(SQLTemplate_EXIMMiddleCount,"%SQLResult_Belegkey%",SQLResult_Belegkey) SQLQuery_EXIMMiddleCount = REPLACE(SQLQuery_EXIMMiddleCount, "%ProductNumber%", ProductNumber) Set SQLResult_EXIMMiddleCount = MConn.Select(SQLQuery_EXIMMiddleCount) 'Get how many ident numbers were found in middle/pos table EXIMMiddleCount = SQLResult_EXIMMiddleCount.value("c999") 'msgbox "EXIMMiddleCount: " & EXIMMiddleCount SQLQuery_EXIMMiddle = "" SQLQuery_EXIMMiddle = REPLACE(SQLTemplate_EXIMMiddle,"%SQLResult_Belegkey%",SQLResult_Belegkey) SQLQuery_EXIMMiddle = REPLACE(SQLQuery_EXIMMiddle, "%ProductNumber%", ProductNumber) Set SQLResult_EXIMMiddle = MConn.Select(SQLQuery_EXIMMiddle) Set DocShapeWindow = CWLStart.CurrentModule.Windows.Item(DocShapeWindowID) Set DocShapeWindowGrid = DocShapeWindow.Controls.Item(DocShapeWindowGridID).Grid ' Macht die Spalte "Beleg" für Eingangslieferscheine sichtbar, 7.9.21 MP DocShapeWindowGrid.SetColumnWidth DocShapeWindowGridBelegColumn, 10 If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then msgbox "EXIMMiddleCount: " & EXIMMiddleCount End If 'loop for every found ident number in middle/pos table For EXIMMiddleCounter = 1 To EXIMMiddleCount If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then msgbox EXIMMiddleCounter & " of " & EXIMMiddleCount & vbCrlf & _ "SQLQuery_EXIMMiddleCount: " & SQLQuery_EXIMMiddleCount & vbCrlf & _ "SQLQuery_EXIMMiddle: " & SQLQuery_EXIMMiddle & vbCrlf & _ "", vbOkayonly+vbInformation, "Loop for every ident number" end If 'Get and set values for this loop ProductSerialNumber = SQLResult_EXIMMiddle.value("ChargeIdentnummer") CurrentLineCount = DocShapeWindowGrid.LineCount NewLineCount = CurrentLineCount + 1 'Fallback Value IF (ProductShape = "") Then ProductShape = "A" End If If ProductSerialNumber <> "" Then 'Product without known Ident number If (ProductIdentType <> "") Then If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then msgbox "Product with unknown Ident number, ProductSerialNumber: " & ProductSerialNumber End if 'new line in window for product ident nr MPushButton DocShapeWindowID, 904, 0 MLastMessageResult = 1 If (ProductShape <> "") Then MSetGridValue DocShapeWindowID, 100, NewLineCount, 3, ProductShape MLastMessageResult = 1 End If If (DeliveryNoteUnsplitted > 0) Then If (DeliveryNoteUnsplitted.value("c998")) <> "" Then 'Invoice nr DocDeliveryNoteUnsplitted = DeliveryNoteUnsplitted.value("c998") Else 'Order nr DocDeliveryNoteUnsplitted = DeliveryNoteUnsplitted.value("c999") End If DocDeliveryNoteUnsplittedProductAmount = DeliveryNoteUnsplitted.value("c995") Else 'Jonathan Jenne: 01.10.2020: 'Added unset variables DocDeliveryNoteUnsplittedProductAmount = 0 DocDeliveryNoteUnsplitted = "" End If ' Vor setzen des Eingangslieferscheins If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then msgbox "DocDeliveryNoteUnsplittedProductAmount: " & DocDeliveryNoteUnsplittedProductAmount & vbCrlf & _ "DocDeliveryNoteUnsplitted: " & DocDeliveryNoteUnsplitted End If MSetGridValue DocShapeWindowID, 100, NewLineCount, 5, ProductSerialNumber MLastMessageResult = 1 'MChangeGridCell DocShapeWindowID, 100, 393222 If (DocDeliveryNoteUnsplittedProductAmount > 0) And (DocDeliveryNoteUnsplitted <> "") Then ' Setzt Eingangslieferschein-Nummer in das Feld "Beleg" MSetGridValue DocShapeWindowID, 100, NewLineCount, DocShapeWindowGridBelegColumn, DocDeliveryNoteUnsplitted ' Setzt den Focus auf das Mengen Feld, um das Feld "Beleg" aktiv zu verlassen DocShapeWindowGrid.SetCurrentCell NewLineCount, 6 ' MP, 0809: Wird hier nicht benötigt, vermutlich 'MLastMessageResult = 1 'DEBUG 'CWLMacro.MStop End If ' Setzt die Menge auf 1.00 MSetGridValue DocShapeWindowID, 100, NewLineCount, 6, "1.00" MLastMessageResult = 1 'Take next doc (Eingangslieferschein), if amount of current doc was reached If (DocDeliveryNoteUnsplittedProductAmount =< EXIMMiddleCounter) Then DeliveryNoteUnsplitted.NextRecord End If 'Product with known Ident number Else If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then msgbox "Product with known Ident number, ProductSerialNumber: " & ProductSerialNumber end if Set DocShapeWindow = CWLStart.CurrentModule.Windows.Item(DocShapeWindowID) Set DocShapeWindowGrid = DocWindow.Controls.Item(DocShapeWindowGridID).Grid 'loop to search for the productnumber in every doc line For DocShapeLineCounter = 1 To DocShapeWindowGrid.LineCount 'msgbox "DocShapeLineCounter: " & DocShapeLineCounter " of " & DocShapeWindowGrid.LineCount ShapeCellValue = DocShapeWindowGrid.GetCellValue(DocShapeLineCounter,DocShapeWindowGridIdentColumn) 'If productnumber was found in current line of the doc If (UCASE(ShapeCellValue) = UCASE(ProductSerialNumber)) Then 'In case of ident product, amount must be "1" MSetGridValue DocShapeWindowID, 100, DocShapeLineCounter, DocShapeWindowGridAmountColumn, "1" Exit For End if Next 'DocShapeWindowGrid.LineCount End If End If SQLResult_EXIMMiddle.NextRecord Next ' Jetzt sind alle Ident Nummern eingetragen für einen Artikel 'Press F5 / okay after all ident numbers were set for this product MLastMessageResult = 1 MPushButton DocShapeWindowID, 98, 0 'DEBUG 'CWLMacro.MStop End if 'ProductType Else 'Set amount to 0 MLastMessageResult = 1 MSetGridValue DocWindowID, 300, DocLineCounter, DocWindowGridAmountColumn, "0" 'Close Ausprägungsfenster if it is opened MLastMessageResult = 1 MPushButton DocShapeWindowID, 99, 0 'MLastMessageResult = 1 'MGridLeftClick 245, 300, DocLineCounter, DocWindowGridLineNumberColumn 'MLastMessageResult = 1 'MPushButton 245, 966, 0 End If 'ProductAmount = 0 End If '(CellValue = ProductNumber) Next 'Switch to next product in t026 SQLResult_DocMid.nextRecord Next 'After all ident product were processed, click "automatisch aufteilen" for other products MLastMessageResult = 1 MPushButton 245, 920, 0 ' Closes the Lagerzuordnungsfenster if it is open MLastMessageResult = 1 MPushButton 674, 99, 0 MLastMessageResult = 1 MPushButton 245, 98, 0 MLastMessageResult = 1 MPushButton 248, 98, 0 MLastMessageResult = 1 MPushButton 248, 99, 0 MLastMessageResult = 1 MComboSelchange 249, 105, "0" MLastMessageResult = 1 MPushButton 249, 99, 0 MLastMessageResult = 1 MActivateWindow 248 MLastMessageResult = 1 MActivateWindow 774 MLastMessageResult = 1 MPushButton 774, 99, 0 End If End If End If End If End If '################################## '########### final part ########### 'if DebugMode enabled or DebugOn is true, go to the Macro Window SwitchWinLineGoToMacros '################################## ) 'Eÿþÿ'Ende von (Deklarationen) e von (Deklarationen) indow SwitchWinLineGoToMacros '################################## ) 'Eÿþÿ'Ende von (Deklarationen) nd If End If '################################## '########### final part ########### 'if DebugMode enabled or DebugOn is true, go to the Macro Window SwitchWinLineGoToMacros '################################## ) 'Eÿþÿ'Ende von (Deklarationen) (Deklarationen) 4 MLastMessageResult = 1 MPushButton 774, 99, 0 End If End If End If End If End If '################################## '########### final part ########### 'if DebugMode enabled or DebugOn is true, go to the Macro Window SwitchWinLineGoToMacros '################################## ) 'Eÿþÿ'Ende von (Deklarationen)