diff --git a/src/sh/tuk/module/Common_Button.bas b/src/sh/tuk/module/Common_Button.bas index 638645f..a1b34a5 100644 --- a/src/sh/tuk/module/Common_Button.bas +++ b/src/sh/tuk/module/Common_Button.bas @@ -48,8 +48,8 @@ Sub RefreshCache_Button() Dim exitMsg As String Dim activeSheetName As String: activeSheetName = ActiveSheet.CodeName - Debug.Print "1. Validate Z1~Z4, T1~T3, O1~O2 master data" - Dim cacheSheets As Variant: cacheSheets = Array("Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2") + Debug.Print "1. Validate Z1~Z4, T1~T3, O1~O3 master data" + Dim cacheSheets As Variant: cacheSheets = Array("Z1", "Z2", "Z3", "T1", "T2", "T3", "O1", "O2", CACHE_O3) Dim sheetName As Variant Dim ws As Worksheet For Each sheetName In cacheSheets diff --git a/src/sh/tuk/module/Common_Global_Cache.bas b/src/sh/tuk/module/Common_Global_Cache.bas index 9f19bf9..796fdfa 100644 --- a/src/sh/tuk/module/Common_Global_Cache.bas +++ b/src/sh/tuk/module/Common_Global_Cache.bas @@ -8,6 +8,9 @@ Option Explicit ' - RefreshM2Cache ' - RefreshO1Cache ' ============================================================ +Public Const CACHE_O3 As String = CACHE_O3 + + Private sheetConfDict As Object Private FormulaCache As Object Public GlobalCache As Object @@ -381,24 +384,6 @@ Private Sub RefreshSheetDict() Set sheetConfDict("Z3") = sheetConf Debug.Print "RefreshSheetDict Z3 ok." - ' Z4 - Set sheetConf = CreateObject("Scripting.Dictionary") - sheetConf("StartCol") = "C" - sheetConf("EndCol") = "I" - sheetConf("ErrorCol") = "B" - sheetConf("StartRow") = 7 - sheetConf("HeaderRow") = 5 - sheetConf("CSV_Encoding") = "utf-8" - sheetConf("HasHeader") = False - sheetConf("ExpectedColumnCount") = 7 - sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I") - sheetConf("AlwaysQuote") = True - sheetConf("FilterRow") = 6 - sheetConf("KeyCol") = 3 - sheetConf("ValueCols") = Array(4) - Set sheetConfDict("Z4") = sheetConf - Debug.Print "RefreshSheetDict Z4 ok." - ' T1 Set sheetConf = CreateObject("Scripting.Dictionary") sheetConf("StartCol") = "C" @@ -487,6 +472,24 @@ Private Sub RefreshSheetDict() Set sheetConfDict("O2") = sheetConf Debug.Print "RefreshSheetDict O2 ok." + ' O3 + Set sheetConf = CreateObject("Scripting.Dictionary") + sheetConf("StartCol") = "C" + sheetConf("EndCol") = "I" + sheetConf("ErrorCol") = "B" + sheetConf("StartRow") = 6 + sheetConf("HeaderRow") = 5 + sheetConf("CSV_Encoding") = "utf-8" + sheetConf("HasHeader") = False + sheetConf("ExpectedColumnCount") = 7 + sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I") + sheetConf("AlwaysQuote") = True + sheetConf("FilterRow") = 5 + sheetConf("KeyCol") = 3 + sheetConf("ValueCols") = Array(4) + Set sheetConfDict(CACHE_O3) = sheetConf + Debug.Print "RefreshSheetDict O3 ok." + ' Enum Set sheetConf = Nothing sheetConfDict("Enum") = Array("tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList") @@ -565,7 +568,7 @@ End Function Public Sub RefreshMasterCache() ' Fixed cache names Dim fixedCaches As Variant - fixedCaches = Array("Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2", _ + fixedCaches = Array("Z1", "Z2", "Z3", "T1", "T2", "T3", "O1", "O2", CACHE_O3, _ "tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList") ' Refresh fixed caches @@ -604,7 +607,7 @@ Public Sub WriteCachesSheet(ByVal cacheName As String) Case "Z1": colLetter = "A" Case "Z2": colLetter = "B" Case "Z3": colLetter = "C" - Case "Z4": colLetter = "D" + Case CACHE_O3: colLetter = "D" Case "T1": colLetter = "E" Case "T2": colLetter = "F" Case "T3": colLetter = "G" diff --git a/src/sh/tuk/module/Common_Selector.bas b/src/sh/tuk/module/Common_Selector.bas index b0d40f9..cb35919 100644 --- a/src/sh/tuk/module/Common_Selector.bas +++ b/src/sh/tuk/module/Common_Selector.bas @@ -38,13 +38,13 @@ End Function ' Create Todoke (G) dropdown Public Function BuildTodokeList() - Dim z4Cache As Object: Set z4Cache = GetCache("Z4") + Dim o3Cache As Object: Set o3Cache = GetCache(CACHE_O3) Dim dropdownList As String Dim key As Variant - For Each key In z4Cache.Keys + For Each key In o3Cache.Keys Dim displayText As String - displayText = MakeSelect(key, z4Cache(key)(0)) + displayText = MakeSelect(key, o3Cache(key)(0)) If dropdownList = "" Then dropdownList = displayText Else diff --git a/src/sh/tuk/sheet/C1.cls b/src/sh/tuk/sheet/C1.cls index a857cd3..f5e97b8 100644 --- a/src/sh/tuk/sheet/C1.cls +++ b/src/sh/tuk/sheet/C1.cls @@ -135,11 +135,11 @@ Private Sub Worksheet_Change(ByVal Target As Range) For Each cellG In Target Dim todoke As String: todoke = Trim(cellG.Value) If todoke <> "" Then - Dim z4Cache As Object: Set z4Cache = GetCache("Z4") + Dim o3Cache As Object: Set o3Cache = GetCache(CACHE_O3) Dim todokeCde As String: todokeCde = GetCode(todoke) - If z4Cache.Exists(todokeCde) Then + If o3Cache.Exists(todokeCde) Then Dim cellH As Range: Set cellH = Me.Cells(cellG.Row, 8) - cellH.Value = z4Cache(todokeCde)(0) + cellH.Value = o3Cache(todokeCde)(0) End If End If Next @@ -816,9 +816,9 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As ' validate CodeSelect ' G column [todoke Cde] Dim ColG As String: ColG = "G" - Dim z4Cache As Object: Set z4Cache = GetCache("Z4") + Dim o3Cache As Object: Set o3Cache = GetCache(CACHE_O3) Dim todokeCde As String: todokeCde = GetCode(Trim(Me.Cells(rowNum, ColG).Value)) - If Not z4Cache.Exists(todokeCde) Then + If Not o3Cache.Exists(todokeCde) Then Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", ColG & rowNum) Me.Range(ColG & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub diff --git a/src/sh/tuk/sheet/O3.cls b/src/sh/tuk/sheet/O3.cls new file mode 100644 index 0000000..5151d79 --- /dev/null +++ b/src/sh/tuk/sheet/O3.cls @@ -0,0 +1,38 @@ +' ============================================================ +' Module Name: Master_Z4_220 +' Module Desc: Z4 master data management (220) +' 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 + +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 + + Exit Sub + +ErrHandler: + lastErrorMsg = Err.Description +End Sub diff --git a/src/sh/tuk/sheet/Z4.cls b/src/sh/tuk/sheet/Z4.cls deleted file mode 100644 index 71e89f0..0000000 --- a/src/sh/tuk/sheet/Z4.cls +++ /dev/null @@ -1,90 +0,0 @@ -' ============================================================ -' Module Name: Master_Z4_220 -' Module Desc: Z4 master data management (220) -' 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 - -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 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") - - ' clear C~I columns background color - Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol)) - clearRange.Interior.Color = vbWhite - - ' C column check - checkResult = CheckRequired(ws, rowNum, 3, errorCol) - If checkResult = False Then Exit Sub - - checkResult = CheckChar(ws, rowNum, 3, 2, errorCol) - If checkResult = False Then Exit Sub - - checkResult = CheckAlphanumeric(ws, rowNum, 3, 2, errorCol) - If checkResult = False Then Exit Sub - - checkResult = CheckDuplicate(ws, rowNum, 3, errorCol) - If checkResult = False Then Exit Sub - - ' D column check - checkResult = CheckRequired(ws, rowNum, 4, errorCol) - If checkResult = False Then Exit Sub - - checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol) - If checkResult = False Then Exit Sub - - ' E column check - checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol) - If checkResult = False Then Exit Sub - - ' F column check - checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol) - If checkResult = False Then Exit Sub - - ' G column check - checkResult = Check01(ws, rowNum, 7, errorCol) - If checkResult = False Then Exit Sub - - ' H column check - checkResult = CheckVarcharOver(ws, rowNum, 8, 80, errorCol) - If checkResult = False Then Exit Sub - - ' I column check - checkResult = Check12(ws, rowNum, 9, errorCol) - If checkResult = False Then Exit Sub - - ws.Cells(rowNum, errorCol).ClearContents - Exit Sub - -ErrHandler: - lastErrorMsg = Err.Description -End Sub diff --git a/通勤手当テンプレート20260525.xlsm b/通勤手当テンプレート20260525.xlsm index ce1ffae..caa0d0d 100644 Binary files a/通勤手当テンプレート20260525.xlsm and b/通勤手当テンプレート20260525.xlsm differ