401 lines
14 KiB
OpenEdge ABL
401 lines
14 KiB
OpenEdge ABL
' ============================================================
|
|
' Module Name: Master_Kukan_detail
|
|
' Module Desc: M2 Kukan detail master data management
|
|
' Module Methods:
|
|
' - Worksheet_Change
|
|
' - FillFromM1
|
|
' - validateButton_Click
|
|
' - Validate
|
|
' ============================================================
|
|
Private Sub Worksheet_Change(ByVal Target As Range)
|
|
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
|
|
If HasHeaderEdit = True Then Exit Sub
|
|
|
|
If Target.EntireRow.Address = Target.Address Then Exit Sub
|
|
|
|
Dim watchArea As Range
|
|
With Me
|
|
Set watchArea = Union( _
|
|
.Columns("C"), _
|
|
.Columns("I:R") _
|
|
)
|
|
End With
|
|
Dim intersectRng As Range: Set intersectRng = Application.Intersect(Target, watchArea)
|
|
If intersectRng Is Nothing Then Exit Sub
|
|
|
|
If Target.Row < 7 Then Exit Sub
|
|
|
|
Application.EnableEvents = False
|
|
On Error GoTo Finally
|
|
|
|
' === Fill D, E when C column changes ===
|
|
If Target.Column = 3 Then
|
|
Dim cell As Range
|
|
For Each cell In Target
|
|
If Trim(cell.Value) = "" Then
|
|
Call ClearRowData(Me, cell.Row)
|
|
GoTo Finally
|
|
Else
|
|
Call FillFromM1(cell.Row)
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
' === Create J dropdown when I column changes ===
|
|
If Target.Column = 9 Then
|
|
Dim cellI As Range
|
|
For Each cellI In Target
|
|
' clear
|
|
Me.Range(Me.Cells(cellI.Row, 10), Me.Cells(cellI.Row, 18)).ClearContents
|
|
Me.Cells(cellI.Row, 11).Validation.Delete
|
|
Me.Range(Me.Cells(cellI.Row, 10), Me.Cells(cellI.Row, 18)).Interior.Color = vbWhite
|
|
Call CreateJDropdown(cellI.Row)
|
|
Next
|
|
End If
|
|
|
|
' === Fill K column when J column changes ===
|
|
If Target.Column = 10 Then
|
|
Dim cellJ As Range
|
|
For Each cellJ In Target
|
|
Call FillKFromJ(cellJ.Row)
|
|
Next
|
|
End If
|
|
|
|
Dim kenshuKbn As String: kenshuKbn = Trim(Me.Range("I" & Target.Row).value)
|
|
Dim restrictedCols As Range
|
|
If kenshuKbn = "1" Then
|
|
Set restrictedCols = Union(Me.Columns("K"), Me.Columns("O"), Me.Columns("P"), Me.Columns("Q"), Me.Columns("R"))
|
|
If Not Intersect(Target, restrictedCols) Is Nothing Then
|
|
Application.EnableEvents = False
|
|
MsgBox "can not be input", vbExclamation
|
|
Application.Undo
|
|
Application.EnableEvents = True
|
|
Exit Sub
|
|
End If
|
|
Else
|
|
Set restrictedCols = Me.Range("K:R") '
|
|
If Not Intersect(Target, restrictedCols) Is Nothing Then
|
|
Application.EnableEvents = False
|
|
MsgBox "can not be input", vbExclamation
|
|
Application.Undo
|
|
Application.EnableEvents = True
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
|
|
Finally:
|
|
Application.EnableEvents = True '
|
|
End Sub
|
|
|
|
Private Sub FillKFromJ(ByVal rowNum As Long)
|
|
Dim iValue As String: iValue = Trim(Me.Range("I" & rowNum).Value)
|
|
Dim jValue As String: jValue = Trim(Me.Range("J" & rowNum).Value)
|
|
Dim code As String: code = GetCode(jValue)
|
|
|
|
If jValue = "" Then
|
|
Me.Range("K" & rowNum).ClearContents
|
|
Exit Sub
|
|
End If
|
|
|
|
' Get cache based on I column value
|
|
Dim cache As Object
|
|
Select Case iValue
|
|
Case "1"
|
|
Set cache = GetCache("T1")
|
|
Case "2"
|
|
Set cache = GetCache("T2")
|
|
Case "3"
|
|
Set cache = GetCache("T3")
|
|
Case Else
|
|
Exit Sub
|
|
End Select
|
|
|
|
If cache Is Nothing Then Exit Sub
|
|
|
|
' Check if J value exists in cache
|
|
|
|
If cache.Exists(code) Then
|
|
Dim cacheVal As Variant: cacheVal = cache(code)
|
|
Me.Range("J" & rowNum).Value = Trim(code)
|
|
Me.Range("K" & rowNum).Value = Trim(cacheVal(0))
|
|
End If
|
|
|
|
Select Case iValue
|
|
Case "1"
|
|
Exit Sub
|
|
Case "2"
|
|
Me.Range("L" & rowNum).Value = Trim(cacheVal(2))
|
|
Me.Range("M" & rowNum).Value = Trim(cacheVal(3))
|
|
Me.Range("N" & rowNum).Value = Trim(cacheVal(4))
|
|
Me.Range("O" & rowNum).Value = Trim(cacheVal(5))
|
|
Me.Range("P" & rowNum).Value = Trim(cacheVal(6))
|
|
Me.Range("Q" & rowNum).Value = Trim(cacheVal(7))
|
|
Case "3"
|
|
Me.Range("L" & rowNum).Value = Trim(cacheVal(1))
|
|
Me.Range("M" & rowNum).Value = Trim(cacheVal(2))
|
|
Case Else
|
|
Exit Sub
|
|
End Select
|
|
|
|
End Sub
|
|
|
|
Private Sub CreateJDropdown(ByVal rowNum As Long)
|
|
Dim iValue As String: iValue = Trim(Me.Range("I" & rowNum).Value)
|
|
Dim targetCell As Range: Set targetCell = Me.Range("J" & rowNum)
|
|
|
|
' Clear existing validation
|
|
targetCell.Validation.Delete
|
|
targetCell.ClearContents
|
|
|
|
' Get cache based on I column value
|
|
Dim cache As Object
|
|
Select Case iValue
|
|
Case "1"
|
|
Set cache = GetCache("T1")
|
|
Me.Range("O" & rowNum).Interior.Color = RGB(192, 192, 192)
|
|
Me.Range("P" & rowNum).Interior.Color = RGB(192, 192, 192)
|
|
Me.Range("Q" & rowNum).Interior.Color = RGB(192, 192, 192)
|
|
Case "2"
|
|
Set cache = GetCache("T2")
|
|
Case "3"
|
|
Set cache = GetCache("T3")
|
|
Me.Range("N" & rowNum).Interior.Color = RGB(192, 192, 192)
|
|
Me.Range("O" & rowNum).Interior.Color = RGB(192, 192, 192)
|
|
Me.Range("P" & rowNum).Interior.Color = RGB(192, 192, 192)
|
|
Me.Range("Q" & rowNum).Interior.Color = RGB(192, 192, 192)
|
|
Case Else
|
|
Exit Sub
|
|
End Select
|
|
|
|
If cache Is Nothing Then Exit Sub
|
|
|
|
' Build dropdown list from cache
|
|
Dim dropdownList As String: dropdownList = ""
|
|
Dim key As Variant
|
|
For Each key In cache.Keys
|
|
Dim displayText As String: displayText = MakeSelect(key, cache(key)(0))
|
|
If dropdownList = "" Then
|
|
dropdownList = displayText
|
|
Else
|
|
dropdownList = dropdownList & "," & displayText
|
|
End If
|
|
Next key
|
|
|
|
If dropdownList <> "" Then
|
|
With targetCell.Validation
|
|
.Add Type:=xlValidateList, Formula1:=dropdownList
|
|
.IgnoreBlank = True
|
|
.InCellDropdown = True
|
|
End With
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub FillFromM1(ByVal rowNum As Long)
|
|
Set ws = Me
|
|
|
|
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
|
|
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
|
|
|
|
' Fill D, E, F, G, H columns from M1 cache
|
|
' D = cache[1]: cache[2] (col 4: col 5)
|
|
' E = cache[3] (col 6)
|
|
' F = cache[4] (col 7)
|
|
' G = cache[5] (col 9)
|
|
' H = cache[6] (col 12)
|
|
|
|
' Check C column in the cache
|
|
If Not m1Cache.Exists(cValue) Then
|
|
ws.Cells(rowNum, 4).Value = ""
|
|
ws.Cells(rowNum, 5).Value = ""
|
|
ws.Cells(rowNum, 6).Value = ""
|
|
ws.Cells(rowNum, 7).Value = ""
|
|
ws.Cells(rowNum, 8).Value = ""
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim cacheVal As Variant: cacheVal = m1Cache(cValue)
|
|
|
|
' D column = cache[1]: cache[2]
|
|
ws.Cells(rowNum, 4).Value = Trim(cacheVal(1)) & ":" & Trim(cacheVal(2))
|
|
' E column = cache[3]
|
|
ws.Cells(rowNum, 5).Value = Trim(cacheVal(3))
|
|
' F column = cache[4]
|
|
ws.Cells(rowNum, 6).Value = Trim(cacheVal(4))
|
|
' G column = cache[5]
|
|
ws.Cells(rowNum, 7).Value = Trim(cacheVal(5))
|
|
' H column = cache[6]
|
|
ws.Cells(rowNum, 8).Value = Trim(cacheVal(6))
|
|
End Sub
|
|
|
|
Private Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
|
|
' Clear from D column onwards
|
|
ws.Range(ws.Cells(rowNum, "D"), ws.Cells(rowNum, "R")).ClearContents
|
|
ws.Range(ws.Cells(rowNum, "C"), ws.Cells(rowNum, "R")).Interior.Color = vbWhite
|
|
ws.Cells(rowNum, "J").Validation.Delete
|
|
ws.Cells(rowNum, "S").ClearContents
|
|
End Sub
|
|
|
|
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
|
|
|
|
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
|
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
|
|
|
Dim startCol As String: startCol = sheetConf("StartCol")
|
|
Dim endCol As String: endCol = sheetConf("EndCol")
|
|
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
|
|
|
|
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
|
|
clearRange.Interior.Color = vbWhite
|
|
|
|
' Check C column in the cache
|
|
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
|
|
|
|
' C column check
|
|
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
|
|
If checkResult = False Then Exit Sub
|
|
|
|
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
|
|
If Not m1Cache.Exists(cValue) Then
|
|
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E004", "C" & rowNum)
|
|
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
|
|
' Check column required
|
|
Dim colLetter As Variant
|
|
For Each colLetter In Array("I", "J", "K", "L", "M")
|
|
If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
|
|
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", colLetter & rowNum)
|
|
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
Next colLetter
|
|
|
|
' Check column numeric (only if has value)
|
|
Dim numericCols As Variant: numericCols = Array("L", "M", "N", "O", "P", "Q", "R")
|
|
Dim col As Variant
|
|
For Each col In numericCols
|
|
Dim val As String: val = Trim(ws.Range(col & rowNum).Value & "")
|
|
If val <> "" And Not IsNumeric(val) Then
|
|
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E011", col & rowNum)
|
|
ws.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
Next col
|
|
|
|
' Check I column in the kenshuKbn
|
|
Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList")
|
|
Dim kenshuKbn As String: kenshuKbn = Trim(ws.Range("I" & rowNum).Value)
|
|
If Not kenshuList.Exists(kenshuKbn) Then
|
|
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E012", "I" & rowNum)
|
|
ws.Range("I" & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
|
|
' Check J column in the T1, T2, T3
|
|
Dim code As String: code = Trim(ws.Range("J" & rowNum).Value)
|
|
Dim name As String: name = Trim(ws.Range("K" & rowNum).Value)
|
|
Dim valueL As String: valueL = Trim(ws.Range("L" & rowNum).Value)
|
|
Dim valueM As String: valueM = Trim(ws.Range("M" & rowNum).Value)
|
|
Dim valueN As String: valueN = Trim(ws.Range("N" & rowNum).Value)
|
|
Dim valueO As String: valueO = Trim(ws.Range("O" & rowNum).Value)
|
|
Dim valueP As String: valueP = Trim(ws.Range("P" & rowNum).Value)
|
|
Dim valueQ As String: valueQ = Trim(ws.Range("Q" & rowNum).Value)
|
|
Dim cache As Object
|
|
Dim requiredCols As Variant
|
|
Dim equaledCols As Variant
|
|
Dim emptyCols As Variant
|
|
If kenshuKbn = "1" Then
|
|
Set cache = GetCache("T1")
|
|
' must input
|
|
equaledCols = Array("K")
|
|
requiredCols = Array("N")
|
|
emptyCols = Array("O", "P", "Q", "R")
|
|
End If
|
|
|
|
If kenshuKbn = "2" Then
|
|
Set cache = GetCache("T2")
|
|
' must input
|
|
equaledCols = Array("K", "L", "M", "N", "O", "P", "Q")
|
|
requiredCols = Array("N", "O", "P", "Q")
|
|
emptyCols = Array("R")
|
|
End If
|
|
|
|
If kenshuKbn = "3" Then
|
|
Set cache = GetCache("T3")
|
|
' must input
|
|
equaledCols = Array("K", "L", "M")
|
|
requiredCols = Array()
|
|
emptyCols = Array("N", "O", "P", "Q", "R")
|
|
End If
|
|
|
|
' code not exist check
|
|
If Not cache.Exists(code) Then
|
|
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E004", "J" & rowNum)
|
|
ws.Range("J" & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
|
|
' Dim equaledColIndex As Long
|
|
' For equaledColIndex = 0 To
|
|
|
|
' Dim equaledCol As Variant
|
|
' For Each equaledCol In equaledCols
|
|
' Dim equalValue As String: equalValue = Trim(ws.Range(equaledCol & rowNum).Value)
|
|
' cache
|
|
' If cache(code)(0) <> name Then
|
|
' Exit Sub
|
|
' End If
|
|
' Me.Range(equaledCol & rowNum).Validation.Delete
|
|
' Next equaledCol
|
|
|
|
Dim requiredCol As Variant
|
|
For Each requiredCol In requiredCols
|
|
Dim requiredValue As String: requiredValue = Trim(ws.Range(requiredCol & rowNum).Value)
|
|
If requiredValue = "" Then
|
|
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", requiredCol & rowNum)
|
|
ws.Range(requiredCol & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
Next requiredCol
|
|
|
|
Dim emptyCol As Variant
|
|
For Each emptyCol In emptyCols
|
|
Dim emptyValue As String: emptyValue = Trim(ws.Range(emptyCol & rowNum).Value)
|
|
If emptyValue <> "" Then
|
|
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", emptyCol & rowNum)
|
|
ws.Range(emptyCol & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
Next emptyCol
|
|
|
|
' check Duplicate
|
|
Dim i As Long
|
|
For i = 7 To rowNum - 1
|
|
If Trim(ws.Cells(i, "C").Value) = cValue And Trim(ws.Cells(i, "I").Value) = kenshuKbn And Trim(ws.Cells(i, "J").Value) = code Then
|
|
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E013", i, checkValue)
|
|
ws.Cells(rowNum, "C").Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
If Trim(ws.Cells(i, "C").Value) = cValue And Trim(ws.Cells(i, "I").Value) = kenshuKbn And Trim(ws.Cells(i, "K").Value) = name Then
|
|
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E013", i, checkValue)
|
|
ws.Cells(rowNum, "C").Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
Next i
|
|
|
|
ws.Cells(rowNum, errorCol).ClearContents
|
|
|
|
End Sub
|
|
|
|
Public Sub ImportCSVAndTriggerChange(ws As Worksheet, ByVal lastDataRow As Long)
|
|
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
|
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
|
|
|
Dim startRow As Long: startRow = sheetConf("StartRow")
|
|
Dim i As Long
|
|
For i = startRow To lastDataRow
|
|
Call FillFromM1(i)
|
|
Next i
|
|
End Sub
|