8
0

Anlage des Repos

This commit is contained in:
2024-01-24 16:42:38 +01:00
commit 38d6a271c4
1785 changed files with 3051496 additions and 0 deletions

View File

@@ -0,0 +1,15 @@
-------------------------------------------------------------------------------
Version 1.0.0.0 - 12.08.2020
NEW: -
FIX: -
CHG: -
REM: -
-------------------------------------legend------------------------------------
NEW: = Added a new functionality
FIX: = Fixed a Issue with existing functionality
CHG: = Changed a existing functionality
REM: = Removed a functionality
-------------------------------------------------------------------------------

View File

@@ -0,0 +1,155 @@
'Remark: Digital Data - Manuelle Preisänderung für einen Artikel aber mehrere Zuordnungen / Preislisteneinträge
'VB Script Document
'
'Digital Data
'Ludwig-Rinn-Straße 16
'35452 Heuchelheim
'Tel.: 0641 / 202360
'E-Mail: info-flow(at)digitaldata.works
'
'Version Number: 1.0.0.0
'Version Date: 16.03.2020
On Error Resume Next
'########## set variables ##########
DebugMode = "Disabled" 'Set to "Enabled", to get debug msgboxes. Default: "Disabled"
MandatorNr = CWLStart.CurrentCompany 'Get current MandantorNr, like "500M".
CurrentUser = CWLStart.CurrentUser 'Get current username like "meso".
Timestamp = Now 'Get current date and time.
SQLQueryBasicWhere = " and (mesocomp = '~~~~') and (mesoyear = yyyy)" '
PriceListInputBoxValue = "1, 2" '"Welche Preisarten sind zu ändern? (1 = Allg. Verkaufspreis; 2 = Gruppenspezificher Preis)"
SQLTablePriceEntry = "T043" 'Set SQL Table for Captions. Default: "T043"
SQLQueryPriceEntry = "c000 = '%ProductNumber%' and c001 in (%ProductPriceType%)" & SQLQueryBasicWhere 'SQL Result has to be one or more lines!
SQLUpdatePriceEntry = ""
ProductNumberInputBoxBodyText = "Bitte geben Sie die Artikelnummer ein, bei welchem die Preistabelle aktualisiert werden soll."
ProductNumberInputBoxHeadText = "Eingabe erforderlich!"
ProductNumber = ""
ProductOldPriceValue = 0
ProductTempPriceValue = 0
ProductNewPriceValueInputBoxBodyText = "Bitte geben Sie die Artikelnummer ein, bei welchem die Preistabelle aktualisiert werden soll."
ProductNewPriceValueInputBoxHeadText = "Eingabe erforderlich, für Artikel: " & ProductNumber
ProductNewPriceValue = 0
SummaryMessage = "Enabled" 'Set to "Enabled", to get a msgbox at the end about all values. Default: Enabled
'########## preparing part ##########
'Reset Error Var
Err.Clear
'Display debug infos, if enabled
If DebugMode = "Enabled" Then
MSGBOX "CurrentUser: " & CurrentUser & vbCrlf & _
"MandatorNr: " & MandatorNr & vbCrlf & _
"Timestamp: " & Timestamp,,"DEBUG - Info: Runtime Variables"
End If
'########## main part ##########
'User has to input the Product number (Artikelnummer)
IF ProductNumber <> "" Then
If DebugMode = "Enabled" Then
MSGBOX "ProductNumber: " & ProductNumber,,"DEBUG - Info: Runtime Variables"
End If
Else
'User has to input the affected price lists (Preisarten)
ProductNumber = InputBox (ProductNumberInputBoxBodyText, ProductNumberInputBoxHeadText, ProductNumber)
End If
'ToDo: Catch wrong input
'Query to price list entrys from Product
Set SQLResultPriceEntry = CWLStart.CurrentCompany.SearchRecord (SQLTablePriceEntry, REPLACE(REPLACE(SQLQueryPriceEntry,"%ProductNumber%",ProductNumber),"%ProductPriceType%",ProductPriceType))
If Err.Number <> 0 Then
MSGBOX "Error Code: "& Err.Number & vbCrlf & _
"Error Description: "& Err.Description,,"ERROR: Getting Captions from DB Table "& SQLTablePriceEntry
Err.Clear
Else
'If no line results
If SQLResultPriceEntry.RowCount = -1 Then
If DebugMode = "Enabled" Then
MSGBOX "No Rows found, SQL: "& SQLQueryPriceEntry,,"DEBUG - Info: Captions from Database table "& SQLTablePriceEntry
Else
MSGBOX "Es wurden keine relevante Listeneinträge gefunden," & vbCrlf & _
"welche geändert werden können.",,"Abfrage auf Arikelnummer: " & ProductInputBoxValue
End If
ElseIF SQLLinesPriceEntry >= 1 Then
SQLLinesPriceEntry = SQLResultPriceEntry.RowCount
If DebugMode = "Enabled" Then
MSGBOX "SQL-Lines: " & SQLLinesPriceEntry & vbCrlf & _
"SQL-Columns: " & SQLResultPriceEntry & vbCrlf & _
"SQL-Table: " & SQLTablePriceEntry & vbCrlf & _
"SQL-Query: " & SQLQueryPriceEntry,,"DEBUG - Info: Query for Captions is a SUCCESS!"
Else
MSGBOX "Es wurden " & SQLLinesPriceEntry & " relevante Listeneinträge gefunden," & vbCrlf & _
"welche geändert werden können.",,"Abfrage auf Arikelnummer: " & ProductInputBoxValue
End If
'What is the new price?
PriceEntryInputBoxValue = InputBox (PriceEntryInputBoxBodyText, PriceEntryInputBoxHeadText, PriceEntryInputBoxValue)
'Start update order into SQL DB
'CWLStart.CurrentCompany.UpdateRecord SQLTableValues, SQLResultValues.ColumnName(LoopCounterValues) & " = '"& InputBoxValue &"'", SQLQueryValues
If Err.Number <> 0 Then
MSGBOX "Error Code: "& Err.Number & vbCrlf & _
"Error Description: "& Err.Description,,"ERROR: Setting Values to DB Table "& SQLTableValues
Err.Clear
End If
If SummaryMessage = "Enabled" Then
SummaryMessageText = SummaryMessageText + SQLResultPriceEntry.value(LoopCounterCaptions) & " = " & InputBoxValue & chr (13)
End if
Else
MSGBOX "Es wird keine Änderung vorgenommen.",,"Ungültige oder abgebrochene Eingabe!"
If SummaryMessage = "Enabled" Then
SummaryMessageText = SummaryMessageText + SQLResultPriceEntry.value(LoopCounterCaptions) & " = <keine Eingabe erfolgt>" & chr (13)
End if
End If
End If
'########## final part ##########
If DebugMode = "Enabled" Then
'Sub RunMacro
' Return to Macro Window
MApplication 2
MApplication 0
MWindow 45, False
MSetFieldFocus 45, 100
MSetFieldFocus 45, -1
MSetFieldFocus 45, -1
MActivateWindow 45
'End Sub
End if

View File

@@ -0,0 +1,22 @@
-------------------------------------------------------------------------------
Version 1.2.1.0 - 26.08.2020
NEW: -
FIX: -
CHG: - New Module Loader Version
REM: -
-------------------------------------------------------------------------------
Version 1.0.0.0 - 12.08.2020
NEW: -
FIX: -
CHG: -
REM: -
-------------------------------------legend------------------------------------
NEW: = Added a new functionality
FIX: = Fixed a Issue with existing functionality
CHG: = Changed a existing functionality
REM: = Removed a functionality
-------------------------------------------------------------------------------