Files
vba/src/sh/tuk/sheet/Z4.cls
2026-05-30 16:47:51 +09:00

87 lines
2.6 KiB
OpenEdge ABL

' ============================================================
' Module Name: Master_Z4_221
' Module Desc: Z4 master data management (221)
' Module Methods:
' - Worksheet_Change
' - Validate
' ============================================================
' ============================================================
' Event Handlers
' ============================================================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
Application.EnableEvents = False
On Error GoTo Finally
' === Column C changes: Create H column dropdown ===
If Target.Column = 3 And Target.Row >= 7 Then
Dim cell As Range
For Each cell In Target
If Trim(cell.Value) = "" Then
Call ClearDataRow(Me, cell.Row)
Else
Call BuildDisplayDropdown(Me, cell.Row)
End If
Next
End If
' === Column H changes: Fill E column ===
If Target.Column = 8 And Target.Row >= 7 Then
Dim cellH As Range
For Each cellH In Target
Dim displayValue As String: displayValue = Trim(cellH.Value)
If displayValue <> "" Then
cellH.Value = GetCode(displayValue)
End If
Next
End If
Application.EnableEvents = True
Exit Sub
Finally:
HandleError "Worksheet_Change"
Application.EnableEvents = True
End Sub
' Prevent insert/delete row in header area
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(Me.CodeName)
Dim filterRow As Long: filterRow = sheetConf("FilterRow")
If Target.Row < filterRow + 1 Then
Cancel = True
MsgBox "Cannot insert or delete row in header area.", vbExclamation
End If
End Sub
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim engine As ValidationRuleEngine: Set engine = New ValidationRuleEngine
With engine
.AddRequired "C"
.AddChar "C", 6
.AddAlphanumeric "C"
.AddDuplicate "C"
.AddRequired "D"
.AddVarchar "D", 80
.AddVarchar "E", 80
.AddRequired "F"
.AddVarchar "F", 80
.AddVarchar "G", 80
.AddCheck01 "H"
End With
Call engine.ValidateRow(ws, rowNum, lastDataRow)
Exit Sub
ErrHandler:
SetLastErrorMsg Err.Description
End Sub