AppStd/Skriptentwickung
8
0
Fork 0
Code
Skriptentwickung/archive/Show-WinLineDuplicates/Installations-Paket/Show-WinLineDuplicates 1.0.0.0/Module/SetDuplicateChecker_TableContent.vbm
KammM 38d6a271c4 Anlage des Repos
2024-01-24 16:42:38 +01:00

587 lines
25 KiB
Plaintext
Raw Blame History

' SetDuplicateChecker_TableContent
' ----------------------------------------------------------------------------
' Diese Subroutine füllt eine Tabelle (Grid) mit Daten
' Parameter 1 (LEVEL) = Das aktuelle Showlevel übergeben.
' Parameter 2 (GRID) = Falls mehrere Grids auf einem Level vorkommen, kann über diesen Parameter nochmals unterscheiden werden.
'
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow@digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.11.2021 / MK
' Version Date / Editor: 01.11.2021 / MK
' Version Number: 1.0.0.0
Sub SetDuplicateChecker_TableContent(LEVEL,GRID)
If (LEVEL = 1) or (LEVEL = "1") Then
If (GRID = LEVEL1_GRID1_ID) Then
IF (LEVEL1_CMB_ProductComparisonField.contents <> Empty) and (LEVEL1_CMB_ProductComparisonField.contents <> "") and (LEVEL1_CMB_ProductComparisonField.contents <> " ") Then
LEVEL1_Grid1.Clear
LEVEL1_Grid1.InitUserGrid
LEVEL1_Grid1.Header
LEVEL1_Grid1.Refresh
SQLQuery_ProductComparison = SQLQuery_ProductComparison_Template
SQLQuery_ProductComparison = Replace(SQLQuery_ProductComparison,"%Field/Attribute%",LEVEL1_CMB_ProductComparisonField.contents)
'If Checkbox is - checked - get all Product types
IF (LEN(LEVEL1_CHK_ProductIdentAndCharge.screencontents) > 0) then
IF (LEVEL1_CHK_ProductIdentAndCharge.screencontents = 1) Then
SQLQuery_ProductComparison = Replace(SQLQuery_ProductComparison,"%TypeConstraint1%","0,1,2")
SQLQuery_ProductComparison = Replace(SQLQuery_ProductComparison,"%TypeConstraint2%","0,1,2,4")
Else
SQLQuery_ProductComparison = Replace(SQLQuery_ProductComparison,"%TypeConstraint1%","0")
SQLQuery_ProductComparison = Replace(SQLQuery_ProductComparison,"%TypeConstraint2%","2")
End if
Else
SQLQuery_ProductComparison = Replace(SQLQuery_ProductComparison,"%TypeConstraint1%","0")
SQLQuery_ProductComparison = Replace(SQLQuery_ProductComparison,"%TypeConstraint2%","2")
End if
'Remove linebreaks (final)
SQLQuery_ProductComparison=Replace(SQLQuery_ProductComparison,vbCr,"")
SQLQuery_ProductComparison=Replace(SQLQuery_ProductComparison,vbLf,"")
'Start query for left grid
Set SQLResult_ProductComparison = Conn.Select(SQLQuery_ProductComparison)
If (SQLResult_ProductComparison.RowCount) > 0 Then
LEVEL1_Grid1.IsRedraw = False
LEVEL1_GRID1_GUID = 0
LoopCounter = 0
'Fill left Frame / Table
If (SQLResult_ProductComparison.RowCount > 0) Then
Do
LEVEL1_GRID1_GUID = LEVEL1_GRID1_GUID+1
CWLCurrentWindow.ActiveWindow.Vars.Value(495,11) = clng(LEVEL1_GRID1_GUID)
CWLCurrentWindow.ActiveWindow.Vars.Value(495,12) = clng(SQLResult_ProductComparison.value(0))
CWLCurrentWindow.ActiveWindow.Vars.Value(495,13) = General.Convert(cstr(SQLResult_ProductComparison.value(1)),2) 'Always convert because of "Notizfelder 1 - 10"
'This construct was bulid to even compare rtf fields
'Preserve in redim is important to save old data
LoopCounter = LoopCounter + 1
ReDim Preserve ProductComparison(ubound(ProductComparison)+1)
ProductComparison(LoopCounter) = SQLResult_ProductComparison.value(1)
'Replace inverted comma and line breaks
ProductComparison(LoopCounter) = Replace(ProductComparison(LoopCounter),"'","")
ProductComparison(LoopCounter) = Replace(ProductComparison(LoopCounter),vbCr,"")
ProductComparison(LoopCounter) = Replace(ProductComparison(LoopCounter),vbLf,"")
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
msgbox ProductComparison(LoopCounter),vbInformation, DEBUG_TITLE & " - LoopCounter: " & LoopCounter
End if
LEVEL1_Grid1.AddLine()
'Trick it, because rowcount wont work
If (SQLResult_ProductComparison.NextRecord = False) Then
Exit Do
End If
Loop
End If
'Show count down below the table
IF (LEVEL1_Grid1.LineCount = 1) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,10) = (Cstr(LEVEL1_Grid1.LineCount) & " Duplikatsgruppe gefunden")
Else
CWLCurrentWindow.ActiveWindow.Vars.Value(495,10) = (Cstr(LEVEL1_Grid1.LineCount) & " Duplikatsgruppen gefunden")
End if
LEVEL1_GRID1.SetFooterColumn LEVEL1_GRID1_COLUMN_FIELD_OR_ATTRIBUTE,"T21,Z10,L30,H10,Zeilenzähler","l","V",0,495,10,true
LEVEL1_GRID1.Footer
LEVEL1_Grid1.IsRedraw = True
'Set focus for the fist call, so ribbon buttons will work well (eg. NEW)
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID,LEVEL1_GRID1_ID
Else
LEVEL1_Grid1.IsRedraw = False
LEVEL1_Grid1.Clear
LEVEL1_Grid1.InitUserGrid
LEVEL1_Grid1.Header
CWLCurrentWindow.ActiveWindow.Vars.Value(495,10) = "Keine Duplikate gefunden"
LEVEL1_GRID1.SetFooterColumn LEVEL1_GRID1_COLUMN_FIELD_OR_ATTRIBUTE,"T21,Z10,L30,H10,Zeilenzähler","l","V",0,495,10,true
LEVEL1_GRID1.Footer
LEVEL1_Grid1.IsRedraw = True
End If
Else
LEVEL1_Grid1.IsRedraw = False
LEVEL1_Grid1.Clear
LEVEL1_Grid1.InitUserGrid
LEVEL1_Grid1.Header
CWLCurrentWindow.ActiveWindow.Vars.Value(495,10) = "Keine Duplikate gefunden"
LEVEL1_GRID1.SetFooterColumn LEVEL1_GRID1_COLUMN_FIELD_OR_ATTRIBUTE,"T21,Z10,L30,H10,Zeilenzähler","l","V",0,495,10,true
LEVEL1_GRID1.Footer
LEVEL1_Grid1.IsRedraw = True
End If
'------------------------------------------------------------------------------------------------------------------------------------------------------------------
ElseIf (GRID = LEVEL1_GRID2_ID) Then
LEVEL1_Grid2.Clear
LEVEL1_Grid2.InitUserGrid
LEVEL1_Grid2.Header
LEVEL1_Grid2.Refresh
SQLQuery_ProductInfo = SQLQuery_ProductInfo_Template
SQLQuery_ProductInfo = Replace(SQLQuery_ProductInfo,"%Field/Attribute%",LEVEL1_CMB_ProductComparisonField.contents)
SQLQuery_ProductInfo = Replace(SQLQuery_ProductInfo,"%Fieldvalue/Attributevalue%",ProductComparison(LEVEL1_GRID1_CURRENT_GUID))
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MsgBox ProductComparison(LEVEL1_GRID1_CURRENT_GUID),vbInformation,DEBUG_TITLE & " - ROW: " & LEVEL1_GRID1_CURRENT_GUID
End if
'If Checkbox is - checked - get all Product types
IF (LEN(LEVEL1_CHK_ProductIdentAndCharge.screencontents) > 0) then
IF (LEVEL1_CHK_ProductIdentAndCharge.screencontents = 1) Then
SQLQuery_ProductInfo = Replace(SQLQuery_ProductInfo,"%TypeConstraint1%","0,1,2")
SQLQuery_ProductInfo = Replace(SQLQuery_ProductInfo,"%TypeConstraint2%","0,1,2,4")
Else
SQLQuery_ProductInfo = Replace(SQLQuery_ProductInfo,"%TypeConstraint1%","0")
SQLQuery_ProductInfo = Replace(SQLQuery_ProductInfo,"%TypeConstraint2%","2")
End if
Else
SQLQuery_ProductInfo = Replace(SQLQuery_ProductInfo,"%TypeConstraint1%","0")
SQLQuery_ProductInfo = Replace(SQLQuery_ProductInfo,"%TypeConstraint2%","2")
End if
SQLQuery_ProductInfo=Replace(SQLQuery_ProductInfo,vbCr,"")
SQLQuery_ProductInfo=Replace(SQLQuery_ProductInfo,vbLf,"")
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MsgBox SQLQuery_ProductInfo,vbInformation,DEBUG_TITLE & " - " & SQLQuery_ProductInfo
End if
'Start query for right grid
Set SQLResult_ProductInfo = Conn.Select(SQLQuery_ProductInfo)
If (SQLResult_ProductInfo.RowCount) > 0 Then
LEVEL1_Grid2.IsRedraw = False
'Fill left Frame / Table
If (SQLResult_ProductInfo.RowCount > 0) Then
Do
'Inactive / Active flag
If (LEN(SQLResult_ProductInfo.value(45)) > 0) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,21) = 0
Else
CWLCurrentWindow.ActiveWindow.Vars.Value(495,21) = 1
End if
'--------------------------------------------------------
ChargeIdentflag = (SQLResult_ProductInfo.value(42)) 'Charge-/Identflag c025 in v021
ShapeTypeFlag = (SQLResult_ProductInfo.value(39)) 'Ausprägungsflag c014 in v021
'Determ type of product. Ident, main, charge or shape of it
''Haupartikel mit Ausprägung (mit Chargennummern)
If (ChargeIdentflag = 0) and (ShapeTypeFlag = 1) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,22) = 1 'Hauptartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,23) = 1 'Ausprägungsartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,24) = 0 'Identartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,25) = 1 'Chargenartikelflag
''Ausprägung mit Chargennummer
ElseIf (ChargeIdentflag = 0) and (ShapeTypeFlag = 2) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,22) = 0 'Hauptartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,23) = 1 'Ausprägungsartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,24) = 0 'Identartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,25) = 1 'Chargenartikelflag
''Haupartikel mit Ausprägung (mit Identnummer)
ElseIf (ChargeIdentflag = 1) and (ShapeTypeFlag = 1) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,22) = 1 'Hauptartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,23) = 1 'Ausprägungsartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,24) = 1 'Identartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,25) = 0 'Chargenartikelflag
''Ausprägung mit Identnummer
ElseIf (ChargeIdentflag = 1) and (ShapeTypeFlag = 2) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,22) = 0 'Hauptartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,23) = 1 'Ausprägungsartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,24) = 1 'Identartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,25) = 0 'Chargenartikelflag
''Haupartikel ohne Ausprägung
ElseIf (ChargeIdentflag = 2) and (ShapeTypeFlag = 0) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,22) = 1 'Hauptartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,23) = 0 'Ausprägungsartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,24) = 0 'Identartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,25) = 0 'Chargenartikelflag
''Haupartikel mit Ausprägung (ohne Chargenverwaltung)
ElseIf (ChargeIdentflag = 2) and (ShapeTypeFlag = 1) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,22) = 1 'Hauptartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,23) = 1 'Ausprägungsartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,24) = 0 'Identartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,25) = 0 'Chargenartikelflag
''Ausprägung (ohne Chargenverwaltung)
ElseIf (ChargeIdentflag = 2) and (ShapeTypeFlag = 2) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,22) = 0 'Hauptartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,23) = 1 'Ausprägungsartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,24) = 0 'Identartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,25) = 0 'Chargenartikelflag
''unknown / not used!
ElseIf (ChargeIdentflag = 3) Then
''Haupartikel mit Ausprägung (mit FIFO)
ElseIf (ChargeIdentflag = 4) and (ShapeTypeFlag = 1) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,22) = 1 'Hauptartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,23) = 1 'Ausprägungsartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,24) = 0 'Identartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,25) = 0 'Chargenartikelflag
''Ausprägung (mit FIFO)
ElseIf (ChargeIdentflag = 4) and (ShapeTypeFlag = 2) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,22) = 0 'Hauptartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,23) = 1 'Ausprägungsartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,24) = 0 'Identartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,25) = 0 'Chargenartikelflag
''Should not happen...
Else
CWLCurrentWindow.ActiveWindow.Vars.Value(495,22) = 0 'Hauptartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,23) = 0 'Ausprägungsartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,24) = 0 'Identartikelflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,25) = 0 'Chargenartikelflag
End if
'--------------------------------------------------------
CWLCurrentWindow.ActiveWindow.Vars.Value(495,26) = (cstr(SQLResult_ProductInfo.value(38))) 'Hauptartikelnummer
CWLCurrentWindow.ActiveWindow.Vars.Value(495,27) = (cstr(SQLResult_ProductInfo.value(36))) 'Artikelnummer
CWLCurrentWindow.ActiveWindow.Vars.Value(495,28) = (cstr(SQLResult_ProductInfo.value(37))) 'Artikelbezeichnung
LEVEL1_Grid2.AddLine()
'Trick it, because rowcount wont work
If (SQLResult_ProductInfo.NextRecord = False) Then
Exit Do
End If
Loop
End If
'Show count down below the table
IF (LEVEL1_Grid2.LineCount = 1) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,20) = (Cstr(LEVEL1_Grid2.LineCount) & " Artikel wird angezeigt")
Else
CWLCurrentWindow.ActiveWindow.Vars.Value(495,20) = (Cstr(LEVEL1_Grid2.LineCount) & " Artikel werden angezeigt")
End if
LEVEL1_Grid2.SetFooterColumn LEVEL1_GRID2_COLUMN_PRODUCT_DESCRIPTION,"T21,Z10,L30,H10,Zeilenzähler","l","V",0,495,20,true
LEVEL1_Grid2.Footer
LEVEL1_Grid2.IsRedraw = True
'Set DrilDown to Line 0, to set it for the column
'50 = Personenkonten, 21 = Artikel
LEVEL1_Grid2.SetDrillDown 0, LEVEL1_GRID2_COLUMN_MAIN_PRODUCT_NUMBER, 21
LEVEL1_Grid2.SetDrillDown 0, LEVEL1_GRID2_COLUMN_PRODUCT_NUMBER, 21
Else
LEVEL1_Grid2.IsRedraw = False
LEVEL1_Grid2.Clear
LEVEL1_Grid2.InitUserGrid
LEVEL1_Grid2.Header
CWLCurrentWindow.ActiveWindow.Vars.Value(495,20) = "Keine Artikel gefunden"
LEVEL1_Grid2.SetFooterColumn LEVEL1_GRID2_COLUMN_PRODUCT_DESCRIPTION,"T21,Z10,L30,H10,Zeilenzähler","l","V",0,495,20,true
LEVEL1_Grid2.Footer
LEVEL1_Grid2.IsRedraw = True
End If
End If
'------------------------------------------------------------------------------------------------------------------------------------------------------------------
ElseIf (LEVEL = 2) or (LEVEL = "2") Then
If (GRID = LEVEL2_Grid1_ID) Then
IF (LEVEL2_CMB_AccountComparisonField.contents <> Empty) and (LEVEL2_CMB_AccountComparisonField.contents <> "") and (LEVEL2_CMB_AccountComparisonField.contents <> " ") Then
LEVEL2_Grid1.Clear
LEVEL2_Grid1.InitUserGrid
LEVEL2_Grid1.Header
LEVEL2_Grid1.Refresh
SQLQuery_AccountComparison = SQLQuery_AccountComparison_Template
SQLQuery_AccountComparison = Replace(SQLQuery_AccountComparison,"%Field/Attribute%",LEVEL2_CMB_AccountComparisonField.contents)
'If Checkbox is - checked - get all Product types
IF (LEN(LEVEL2_CHK_AccountNotOnlyCustomers.ScreenContents) > 0) then
IF (LEVEL2_CHK_AccountNotOnlyCustomers.ScreenContents = 1) Then
SQLQuery_AccountComparison = Replace(SQLQuery_AccountComparison,"%TypeConstraint%","2,3,4,5")
Else
SQLQuery_AccountComparison = Replace(SQLQuery_AccountComparison,"%TypeConstraint%","2")
End if
Else
SQLQuery_AccountComparison = Replace(SQLQuery_AccountComparison,"%TypeConstraint%","2")
End if
'Remove linebreaks
SQLResult_AccountComparison=Replace(SQLResult_AccountComparison,vbCr,"")
SQLResult_AccountComparison=Replace(SQLResult_AccountComparison,vbLf,"")
'Start query for left grid
Set SQLResult_AccountComparison = Conn.Select(SQLQuery_AccountComparison)
If (SQLResult_AccountComparison.RowCount) > 0 Then
LEVEL2_Grid1.IsRedraw = False
LEVEL2_GRID1_GUID = 0
LoopCounter = 0
'Fill left Frame / Table
If (SQLResult_AccountComparison.RowCount > 0) Then
Do
LEVEL2_GRID1_GUID = LEVEL2_GRID1_GUID+1
CWLCurrentWindow.ActiveWindow.Vars.Value(495,41) = clng(LEVEL2_GRID1_GUID)
CWLCurrentWindow.ActiveWindow.Vars.Value(495,42) = clng(SQLResult_AccountComparison.value(0))
CWLCurrentWindow.ActiveWindow.Vars.Value(495,43) = General.Convert(cstr(SQLResult_AccountComparison.value(1)),2)
'This construct was bulid to even compare rtf fields
'Preserve in redim is important to save old data
LoopCounter = LoopCounter + 1
ReDim Preserve AccountComparison(ubound(AccountComparison)+1)
AccountComparison(LoopCounter) = SQLResult_AccountComparison.value(1)
'Replace inverted comma and line breaks
AccountComparison(LoopCounter) = Replace(AccountComparison(LoopCounter),"'","")
AccountComparison(LoopCounter) = Replace(AccountComparison(LoopCounter),vbCr,"")
AccountComparison(LoopCounter) = Replace(AccountComparison(LoopCounter),vbLf,"")
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
msgbox AccountComparison(LoopCounter),vbInformation, DEBUG_TITLE & " - LoopCounter: " & LoopCounter
End if
LEVEL2_Grid1.AddLine()
'Trick it, because rowcount wont work
If (SQLResult_AccountComparison.NextRecord = False) Then
Exit Do
End If
Loop
End If
'Show count down below the table
IF (LEVEL2_Grid1.LineCount = 1) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,40) = (Cstr(LEVEL2_Grid1.LineCount) & " Duplikatsgruppe gefunden")
Else
CWLCurrentWindow.ActiveWindow.Vars.Value(495,40) = (Cstr(LEVEL2_Grid1.LineCount) & " Duplikatsgruppen gefunden")
End if
LEVEL2_GRID1.SetFooterColumn LEVEL2_GRID1_COLUMN_FIELD_OR_ATTRIBUTE,"T21,Z10,L30,H10,Zeilenzähler","l","V",0,495,40,true
LEVEL2_GRID1.Footer
LEVEL2_Grid1.IsRedraw = True
'Set focus for the fist call, so ribbon buttons will work well (eg. NEW)
MacroCommands.MSetFieldFocus MAIN_WINDOW_ID,LEVEL2_Grid1_ID
Else
LEVEL2_Grid1.IsRedraw = False
LEVEL2_Grid1.Clear
LEVEL2_Grid1.InitUserGrid
LEVEL2_Grid1.Header
CWLCurrentWindow.ActiveWindow.Vars.Value(495,40) = "Keine Duplikate gefunden"
LEVEL2_GRID1.SetFooterColumn LEVEL2_GRID1_COLUMN_FIELD_OR_ATTRIBUTE,"T21,Z10,L30,H10,Zeilenzähler","l","V",0,495,40,true
LEVEL2_GRID1.Footer
LEVEL2_Grid1.IsRedraw = True
End if
Else
LEVEL2_Grid1.IsRedraw = False
LEVEL2_Grid1.Clear
LEVEL2_Grid1.InitUserGrid
LEVEL2_Grid1.Header
CWLCurrentWindow.ActiveWindow.Vars.Value(495,40) = "Keine Duplikate gefunden"
LEVEL2_GRID1.SetFooterColumn LEVEL2_GRID1_COLUMN_FIELD_OR_ATTRIBUTE,"T21,Z10,L30,H10,Zeilenzähler","l","V",0,495,40,true
LEVEL2_GRID1.Footer
LEVEL2_Grid1.IsRedraw = True
End If
'------------------------------------------------------------------------------------------------------------------------------------------------------------------
ElseIf (GRID = LEVEL2_Grid2_ID) Then
LEVEL2_Grid2.Clear
LEVEL2_Grid2.InitUserGrid
LEVEL2_Grid2.Header
LEVEL2_Grid2.Refresh
SQLQuery_AccountInfo = SQLQuery_AccountInfo_Template
SQLQuery_AccountInfo = Replace(SQLQuery_AccountInfo,"%Field/Attribute%",LEVEL2_CMB_AccountComparisonField.contents)
SQLQuery_AccountInfo = Replace(SQLQuery_AccountInfo,"%Fieldvalue/Attributevalue%",AccountComparison(LEVEL2_GRID1_CURRENT_GUID))
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MsgBox AccountComparison(LEVEL2_GRID1_CURRENT_GUID),vbInformation,DEBUG_TITLE & " - ROW: " & LEVEL2_GRID1_CURRENT_GUID
End if
'If Checkbox is - checked - get all Product types
IF (LEN(LEVEL2_CHK_AccountNotOnlyCustomers.screencontents) > 0) then
IF (LEVEL2_CHK_AccountNotOnlyCustomers.screencontents = 1) Then
SQLQuery_AccountInfo = Replace(SQLQuery_AccountInfo,"%TypeConstraint%","2,3,4,5")
Else
SQLQuery_AccountInfo = Replace(SQLQuery_AccountInfo,"%TypeConstraint%","2")
End if
Else
SQLQuery_AccountInfo = Replace(SQLQuery_AccountInfo,"%TypeConstraint%","2")
End if
SQLQuery_AccountInfo=Replace(SQLQuery_AccountInfo,vbCr,"")
SQLQuery_AccountInfo=Replace(SQLQuery_AccountInfo,vbLf,"")
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MsgBox SQLQuery_AccountInfo,vbInformation,DEBUG_TITLE & " - " & SQLQuery_AccountInfo
End if
'Start query for right grid
Set SQLResult_AccountInfo = Conn.Select(SQLQuery_AccountInfo)
If (SQLResult_AccountInfo.RowCount) > 0 Then
LEVEL2_Grid2.IsRedraw = False
'Fill left Frame / Table
If (SQLResult_AccountInfo.RowCount > 0) Then
Do
'Inactive / Active flag
If (LEN(SQLResult_AccountInfo.value(52)) > 0) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,51) = 0
Else
CWLCurrentWindow.ActiveWindow.Vars.Value(495,51) = 1
End if
'--------------------------------------------------------
AccountFlag = cint(SQLResult_AccountInfo.value(3)) 'Charge-/Identflag c025 in v021
'Determ type of account
''Kundenkonto
If (AccountFlag = 2) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,52) = 1 'Kundeflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,53) = 0 'Lieferantflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,54) = 0 'Kunde (Interessent) flag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,55) = 0 'Lieferant (Interessent) flag
''Lieferant
ElseIf (AccountFlag = 3) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,52) = 0 'Kundeflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,53) = 1 'Lieferantflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,54) = 0 'Kunde (Interessent) flag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,55) = 0 'Lieferant (Interessent) flag
''Kunde (Interessent)
ElseIf (AccountFlag = 4) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,52) = 0 'Kundeflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,53) = 0 'Lieferantflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,54) = 1 'Kunde (Interessent) flag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,55) = 0 'Lieferant (Interessent) flag
''Lieferant (Interessent)
ElseIf (AccountFlag = 5) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,52) = 0 'Kundeflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,53) = 0 'Lieferantflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,54) = 0 'Kunde (Interessent) flag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,55) = 1 'Lieferant (Interessent) flag
''Should not happen...
Else
CWLCurrentWindow.ActiveWindow.Vars.Value(495,52) = 0 'Kundeflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,53) = 0 'Lieferantflag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,54) = 0 'Kunde (Interessent) flag
CWLCurrentWindow.ActiveWindow.Vars.Value(495,55) = 0 'Lieferant (Interessent) flag
End if
'--------------------------------------------------------
CWLCurrentWindow.ActiveWindow.Vars.Value(495,56) = (cstr(SQLResult_AccountInfo.value(49))) 'FAKT Kontonummer
CWLCurrentWindow.ActiveWindow.Vars.Value(495,57) = (cstr(SQLResult_AccountInfo.value(50))) 'FIBU Kontonummer
CWLCurrentWindow.ActiveWindow.Vars.Value(495,58) = (cstr(SQLResult_AccountInfo.value(1))) 'Kontonummer
CWLCurrentWindow.ActiveWindow.Vars.Value(495,59) = (cstr(SQLResult_AccountInfo.value(2))) 'Kontobeschreibung
LEVEL2_Grid2.AddLine()
'Trick it, because rowcount wont work
If (SQLResult_AccountInfo.NextRecord = False) Then
Exit Do
End If
Loop
End If
'Show count down below the table
IF (LEVEL2_Grid2.LineCount = 1) Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,50) = (Cstr(LEVEL2_Grid2.LineCount) & " Konto wird angezeigt")
Else
CWLCurrentWindow.ActiveWindow.Vars.Value(495,50) = (Cstr(LEVEL2_Grid2.LineCount) & " Konten werden angezeigt")
End if
LEVEL2_Grid2.SetFooterColumn LEVEL2_GRID2_COLUMN_ACCOUNT_DESCRIPTION,"T21,Z10,L30,H10,Zeilenzähler","l","V",0,495,50,true
LEVEL2_Grid2.Footer
LEVEL2_Grid2.IsRedraw = True
'Set DrilDown to Line 0, to set it for the column
'50 = Personenkonten, 21 = Artikel
LEVEL2_Grid2.SetDrillDown 0, LEVEL2_GRID2_COLUMN_FAKTSUBACCOUNTNR, 50
LEVEL2_Grid2.SetDrillDown 0, LEVEL2_GRID2_COLUMN_FIBUSUBACCOUNTNR, 50
LEVEL2_Grid2.SetDrillDown 0, LEVEL2_GRID2_COLUMN_ACCOUNT_NUMBER, 50
Else
LEVEL2_Grid2.IsRedraw = False
LEVEL2_Grid2.Clear
LEVEL2_Grid2.InitUserGrid
LEVEL2_Grid2.Header
CWLCurrentWindow.ActiveWindow.Vars.Value(495,50) = "Keine Konten gefunden"
LEVEL2_Grid2.SetFooterColumn LEVEL2_GRID2_COLUMN_ACCOUNT_DESCRIPTION,"T21,Z10,L30,H10,Zeilenzähler","l","V",0,495,50,true
LEVEL2_Grid2.Footer
LEVEL2_Grid2.IsRedraw = True
End If
End If
End if
End Sub
View Git Blame Copy Permalink