diff --git a/src/sh/tuk/module/Common_Button.bas b/src/sh/tuk/module/Common_Button.bas index 3b546e7..f0527e5 100644 --- a/src/sh/tuk/module/Common_Button.bas +++ b/src/sh/tuk/module/Common_Button.bas @@ -1,11 +1,24 @@ Attribute VB_Name = "Common_Button" Option Explicit + +' --- Public Variables --- +Public lastErrorMsg As String + ' ============================================================ ' Module Name: Common_Button -' Module Desc: Common_Button +' Module Desc: Common Button handlers with centralized error handling ' Module Methods: ' - CSV_Import_Button +' - Validation_Button +' - CSV_Export_Button +' - Sort_Button +' - Filter_Button +' - Fit_Button +' - RefreshCache_Button ' ============================================================ + +' --- Public Button Functions --- + Sub CSV_Import_Button() DO_CSV_Import ActiveSheet End Sub @@ -54,7 +67,6 @@ Sub RefreshCache_Button() Call RefreshMasterCache() Debug.Print "3. Determine which cache sheets to refresh based on ActiveSheet" - Dim refSheets As Variant If activeSheetName = "C1" Then ' first is M1 Call ValidateKukanCache("M1") @@ -77,43 +89,22 @@ Sub RefreshCache_Button() ErrorHandler: HandleError "RefreshCache_Button" - If exitMsg <> "" Then - MsgBox "RefreshCache_Button: " & exitMsg, vbExclamation - Else - MsgBox "RefreshCache_Button: " & Err.Description, vbExclamation - End If End Sub Private Sub ValidateKukanCache(ByVal sheetName As String) - On Error GoTo ErrorHandler - Dim exitMsg As String Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(CStr(sheetName)) Dim result As Long: result = RunValidationSilent(ws) If result = 0 Then - exitMsg = sheetName & " sheet has no data." - GoTo ErrorHandler + Err.Raise ERR_CACHE_EMPTY, "ValidateKukanCache", sheetName & " sheet has no data." End If - If result < 0 Then - exitMsg = "Can't refresh " & sheetName & " cache. Validation error occurs." - GoTo ErrorHandler - End If - - Exit Sub - -ErrorHandler: - If exitMsg <> "" Then - MsgBox "ValidateKukanCache: " & exitMsg, vbExclamation - Else - MsgBox "ValidateKukanCache: " & Err.Description, vbExclamation + If result = -1 Then + Err.Raise ERR_VALIDATION_FAILED, "ValidateKukanCache", "Validation error in " & sheetName & " sheet." End If End Sub Private Sub UpdateByMaster(ByVal sheetName As String) - On Error GoTo ErrorHandler - Dim exitMsg As String - Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(CStr(sheetName)) Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() @@ -121,19 +112,13 @@ Private Sub UpdateByMaster(ByVal sheetName As String) Dim startRow As Long: startRow = sheetConf("StartRow") Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws) Application.Run sheetName & ".Refresh", ws, startRow, lastDataRow - - Exit Sub - -ErrorHandler: - If exitMsg <> "" Then - MsgBox "UpdateByMaster: " & exitMsg, vbExclamation - Else - MsgBox "UpdateByMaster: " & Err.Description, vbExclamation - End If End Sub +' ============================================================ +' CSV Import with error handler +' ============================================================ Private Sub DO_CSV_Import(ws As Excel.Worksheet) - On Error GoTo ImportError + On Error GoTo ErrorHandler ' Step 1: get csv encoding Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() @@ -147,71 +132,61 @@ Private Sub DO_CSV_Import(ws As Excel.Worksheet) ' Step 3: Read CSV and return 2D array Dim csvData As Variant: csvData = ReadCSVAs2DArrayStrict(filePath, expectedColumnCount, cfg("CSV_Encoding"), cfg("HasHeader")) - If Not IsArray(csvData) Then - MsgBox "No valid data returned from CSV.", vbExclamation - GoTo FinallyExit + If Not IsArray(csvData) Or UBound(csvData, 1) < 1 Then + Err.Raise ERR_FILE_EMPTY, "DO_CSV_Import", "No data in CSV." End If - If UBound(csvData, 1) < 1 Then - MsgBox "No data in CSV.", vbExclamation - GoTo FinallyExit - End If - - ' === Step 3:Clear all data rows before import === + ' === Step 4: Clear all data rows before import === Application.ScreenUpdating = False Application.EnableEvents = False Call ClearDataRows(ws) - ' === Step 4: Write CSV data to worksheet === + ' === Step 5: Write CSV data to worksheet === Dim colLetters As Variant: colLetters = cfg("HeaderColumns") Dim writeRow As Long: writeRow = cfg("StartRow") Dim i As Long - ' loop row For i = LBound(csvData, 1) To UBound(csvData, 1) Dim j As Long - ' loop column For j = 0 To expectedColumnCount - 1 ws.Cells(writeRow, ws.Range(colLetters(j) & "1").Column).Value = CleanCSVField(CStr(csvData(i, j + 1))) Next j writeRow = writeRow + 1 Next i - ' === Step 5: Trigger sheet-specific import handler === - If ProcedureExists(ws.CodeName, "ImportCSVAndTriggerChange") Then - Call Application.Run(ws.CodeName & ".ImportCSVAndTriggerChange", ws, writeRow) - End If - MsgBox writeRow - cfg("StartRow") & " rows imported.", vbInformation GoTo FinallyExit -ImportError: - MsgBox "CSV import failed: " & Err.Description, vbExclamation +ErrorHandler: + HandleError "DO_CSV_Import" + GoTo FinallyExit FinallyExit: Application.EnableEvents = True Application.ScreenUpdating = True End Sub -' +' ============================================================ +' Do_Validation with HandleError +' ============================================================ Private Sub Do_Validation(ws As Excel.Worksheet) On Error GoTo ErrorHandler - Dim exitMsg As String Dim result As Long: result = RunValidationSilent(ws) If result = -1 Then - exitMsg = "Validation has errors." - GoTo ErrorHandler - ElseIf result = 0 Then - exitMsg = "No data to validate." - GoTo ErrorHandler - Else - If ws.CodeName <> "C1" Then - RefreshCache(ws.CodeName) - WriteCachesSheet(ws.CodeName) - End If - MsgBox "Validation complete. Success: " & result, vbInformation + Err.Raise ERR_VALIDATION_FAILED, "Do_Validation", "Validation has errors." End If + + If result = 0 Then + Err.Raise ERR_CACHE_EMPTY, "Do_Validation", "No data to validate." + End If + + If ws.CodeName <> "C1" Then + RefreshCache(ws.CodeName) + WriteCachesSheet(ws.CodeName) + End If + + MsgBox "Validation complete. Success: " & result, vbInformation ' step2. ValidateWarn for M1 sheet If ws.CodeName = "M1" Then @@ -220,33 +195,27 @@ Private Sub Do_Validation(ws As Excel.Worksheet) End If Do_Fit ws - Exit Sub ErrorHandler: HandleError "Do_Validation" - ' If exitMsg <> "" Then - ' MsgBox "Do_Validation: " & exitMsg, vbExclamation - ' Else - ' MsgBox "Do_Validation: " & Err.Description, vbExclamation - ' End If End Sub -' +' ============================================================ +' CSV Export with HandleError +' ============================================================ Private Sub DO_CSV_Export(ws As Excel.Worksheet) - On Error GoTo ExportError + On Error GoTo ErrorHandler ' === Step 1: Validate all rows before export === Dim result As Long: result = RunValidationSilent(ws) If result = 0 Then - MsgBox "No data rows to output.", vbExclamation - Exit Sub + Err.Raise ERR_CACHE_EMPTY, "DO_CSV_Export", "No data rows to output." End If If result < 0 Then - MsgBox "Validation failed. Export aborted.", vbCritical - Exit Sub + Err.Raise ERR_VALIDATION_FAILED, "DO_CSV_Export", "Validation failed. Export aborted." End If ' === Step 2: Select save path === @@ -269,7 +238,6 @@ Private Sub DO_CSV_Export(ws As Excel.Worksheet) Dim dataRow As Long: dataRow = 1 Dim outputArr As Variant - ' when has header + 1 If hasHeader Then ReDim outputArr(1 To rowCount + 1, 1 To expectedColumnCount) Else @@ -292,22 +260,23 @@ Private Sub DO_CSV_Export(ws As Excel.Worksheet) Dim r As Long For r = startRow To lastDataRow For colIdx = 0 To expectedColumnCount - 1 - outputArr(dataRow, colIdx + 1) = CleanCSVField(ws.Cells(r, Columns(colLetters(colIdx)).Column).Value) + outputArr(dataRow, colIdx + 1) = CleanCSVField(ws.Cells(r, Columns(colLetters(colIdx))).Column).Value) Next colIdx dataRow = dataRow + 1 Next r - On Error GoTo ExportError Call WriteCSVFromArray(savePath, outputArr, sheetConf("CSV_Encoding"), sheetConf("AlwaysQuote")) - On Error GoTo 0 MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation Exit Sub -ExportError: - MsgBox "CSV export failed: " & Err.Description, vbExclamation +ErrorHandler: + HandleError "DO_CSV_Export" End Sub +' ============================================================ +' Do_Sort with HandleError +' ============================================================ Private Sub Do_Sort(ws As Excel.Worksheet) On Error GoTo ErrorHandler @@ -320,8 +289,7 @@ Private Sub Do_Sort(ws As Excel.Worksheet) Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws) If lastDataRow < startRow Then - MsgBox "No data to sort.", vbExclamation - Exit Sub + Err.Raise ERR_CACHE_EMPTY, "Do_Sort", "No data to sort." End If Dim sortRange As Range: Set sortRange = ws.Range(ws.Cells(startRow, ws.Range(startCol & "1").Column), ws.Cells(lastDataRow, ws.Range(endCol & "1").Column)) @@ -332,9 +300,12 @@ Private Sub Do_Sort(ws As Excel.Worksheet) Exit Sub ErrorHandler: - MsgBox "Error: " & Err.Description, vbCritical + HandleError "Do_Sort" End Sub +' ============================================================ +' Do_Filter with HandleError +' ============================================================ Private Sub Do_Filter(ws As Excel.Worksheet) On Error GoTo ErrorHandler @@ -357,16 +328,19 @@ Private Sub Do_Filter(ws As Excel.Worksheet) Exit Sub ErrorHandler: - MsgBox "Error: " & Err.Description, vbCritical + HandleError "Do_Filter" End Sub +' ============================================================ +' Do_Fit with HandleError +' ============================================================ Private Sub Do_Fit(ws As Excel.Worksheet) On Error GoTo ErrorHandler Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) - ' 2026-05-15 adjust width function contains error column + ' adjust width function contains error column Dim startCol As String: startCol = sheetConf("ErrorCol") Dim endCol As String: endCol = sheetConf("EndCol") @@ -374,14 +348,16 @@ Private Sub Do_Fit(ws As Excel.Worksheet) Exit Sub ErrorHandler: - MsgBox "Error: " & Err.Description, vbCritical + HandleError "Do_Fit" End Sub +' ============================================================ ' RunValidationSilent -' Positive number = success (number of rows with no errors) -' 0 = no data -' -1 = has errors -' -2 = runtime error +' Returns: +' - Positive number = success (number of rows validated) +' - 0 = no data +' - -1 = has errors +' ============================================================ Public Function RunValidationSilent(ws As Worksheet) As Long Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) @@ -399,8 +375,12 @@ Public Function RunValidationSilent(ws As Worksheet) As Long Dim r As Long Dim hasError As Boolean: hasError = False For r = startRow To lastDataRow + lastErrorMsg = "" Application.Run validate, ws, r, lastDataRow - Dim errorMessage As String : errorMessage = Trim(ws.Cells(r, errorCol).Value) + If lastErrorMsg <> "" Then + Err.Raise ERR_VALIDATION_FAILED, "RunValidationSilent", lastErrorMsg + End If + Dim errorMessage As String: errorMessage = Trim(ws.Cells(r, errorCol).Value) Dim errorCode As String: errorCode = GetCode(errorMessage) If errorCode <> "W001" And errorCode <> "" Then hasError = True @@ -416,12 +396,14 @@ Public Function RunValidationSilent(ws As Worksheet) As Long Exit Function End Function -Public Sub HandleError(sourceProcedure As String) - Dim msg As String +' ============================================================ +' Error Handlers +' ============================================================ - Select Case Err.Number - Case ERR_CACHE_EMPTY - msg = Err.Description - MsgBox msg, vbExclamation - End Select +' Main error handler - centralized error processing +Public Sub HandleError(Optional ByVal sourceProcedure As String = "") + Dim shortCode As String: shortCode = Right("0000" & CStr(Err.Number - vbObjectError), 4) + MsgBox "[ERROR] " & shortCode & " : " & Err.Description, vbExclamation + + End Sub diff --git a/src/sh/tuk/module/Common_Constants.bas b/src/sh/tuk/module/Common_Constants.bas index 6981006..13497b0 100644 --- a/src/sh/tuk/module/Common_Constants.bas +++ b/src/sh/tuk/module/Common_Constants.bas @@ -2,9 +2,35 @@ Attribute VB_Name = "Common_Constants" Option Explicit ' ============================================================ ' Module Name: Common_Constants -' Module Desc: Common_Constants -' Module Methods: +' Module Desc: Common Error Constants +' Module Error Codes: +' - Cache errors (1001-1003) +' - File/CSV errors (5001-5009) +' - Config errors (1004-1006) +' - Validation errors (2001+) ' ============================================================ + +' --- Cache errors --- Public Const ERR_CACHE_NOT_FOUND As Long = vbObjectError + 1001 Public Const ERR_CACHE_EMPTY As Long = vbObjectError + 1002 -Public Const ERR_VALIDATION_FAILED As Long = vbObjectError + 1003 \ No newline at end of file +Public Const ERR_VALIDATION_FAILED As Long = vbObjectError + 1003 + +' --- File/CSV errors --- +Public Const ERR_FILE_INVALID_ARRAY As Long = vbObjectError + 5001 +Public Const ERR_FILE_NOT_2D As Long = vbObjectError + 5002 +Public Const ERR_FILE_NOT_FOUND As Long = vbObjectError + 5003 +Public Const ERR_FILE_EMPTY As Long = vbObjectError + 5004 +Public Const ERR_FILE_NO_DATA As Long = vbObjectError + 5005 +Public Const ERR_FILE_COLUMN_MISMATCH As Long = vbObjectError + 5006 +Public Const ERR_FILE_INVALID_PARAM As Long = vbObjectError + 5007 +Public Const ERR_FILE_WRITE_FAILED As Long = vbObjectError + 5008 +Public Const ERR_FILE_INVALID_DATA As Long = vbObjectError + 5009 + +' --- Config/Sheet errors --- +Public Const ERR_CONFIG_NOT_FOUND As Long = vbObjectError + 1004 +Public Const ERR_CONFIG_INVALID As Long = vbObjectError + 1005 +Public Const ERR_CONFIG_EMPTY_PARAM As Long = vbObjectError + 1006 +Public Const ERR_SHEET_MISSING As Long = vbObjectError + 1007 + +' --- Validation errors --- +Public Const ERR_VALIDATION As Long = vbObjectError + 2001 \ No newline at end of file diff --git a/src/sh/tuk/module/Common_File_Utils.bas b/src/sh/tuk/module/Common_File_Utils.bas index 4df395c..bd1ed64 100644 --- a/src/sh/tuk/module/Common_File_Utils.bas +++ b/src/sh/tuk/module/Common_File_Utils.bas @@ -36,15 +36,13 @@ Sub WriteCSVFromArray( _ ) ' === Input validation === If Not IsArray(data) Then - Err.Raise 513, , "Input 'data' must be an array." + Err.Raise ERR_FILE_INVALID_ARRAY, "WriteCSVFromArray", "Input 'data' must be an array." End If - Dim numDims As Long - On Error Resume Next - numDims = ArrayDimensions(data) - On Error GoTo 0 + ' === Check if 2D array === + Dim numDims As Long: numDims = ArrayDimensions(data) If numDims <> 2 Then - Err.Raise 514, , "Input array must be 2-dimensional." + Err.Raise ERR_FILE_NOT_2D, "WriteCSVFromArray", "Input array must be 2-dimensional." End If Dim rows As Long, cols As Long @@ -110,13 +108,12 @@ End Sub ' Helper function: safely convert any Variant to a string Private Function SafeToString(ByVal v As Variant) As String - On Error Resume Next If IsNull(v) Or IsEmpty(v) Then SafeToString = "" - Else - SafeToString = CStr(v) + Exit Function End If - On Error GoTo 0 + + SafeToString = CStr(v) End Function ' Helper function: get the number of dimensions of an array (1, 2, ...) @@ -188,11 +185,11 @@ Function ReadCSVAs2DArrayStrict( _ ' === validate expectedColumnCount === If expectedColumnCount <= 0 Then - Err.Raise 5001, , "expectedColumnCount must be >= 1." + Err.Raise ERR_FILE_INVALID_PARAM, "ReadCSVAs2DArrayStrict", "expectedColumnCount must be >= 1." End If If Dir(filePath) = "" Then - Err.Raise 5002, , "File not found: " & filePath + Err.Raise ERR_FILE_NOT_FOUND, "ReadCSVAs2DArrayStrict", "File not found: " & filePath End If ' === read csv file === @@ -218,12 +215,12 @@ Function ReadCSVAs2DArrayStrict( _ ' === validate empty === If lines.Count = 0 Then - Err.Raise 5003, , "CSV file is empty." + Err.Raise ERR_FILE_EMPTY, "ReadCSVAs2DArrayStrict", "CSV file is empty." End If If lines.Count = 1 Then If hasHeader Then - Err.Raise 5005, , "CSV file data is empty." + Err.Raise ERR_FILE_NO_DATA, "ReadCSVAs2DArrayStrict", "CSV file data is empty." End If End If @@ -236,7 +233,7 @@ Function ReadCSVAs2DArrayStrict( _ actualCols = UBound(rowArr) - LBound(rowArr) + 1 If actualCols <> expectedColumnCount Then - Err.Raise 5004, , "Row " & i & ": Expected " & expectedColumnCount & " columns, got " & actualCols & "." + Err.Raise ERR_FILE_COLUMN_MISMATCH, "ReadCSVAs2DArrayStrict", "Row " & i & ": Expected " & expectedColumnCount & " columns, got " & actualCols & "." End If Next i diff --git a/src/sh/tuk/module/Common_Functions.bas b/src/sh/tuk/module/Common_Functions.bas index 5e5c9df..fbb30b3 100644 --- a/src/sh/tuk/module/Common_Functions.bas +++ b/src/sh/tuk/module/Common_Functions.bas @@ -42,7 +42,7 @@ Function GetCSVHeader(ByVal ws As Worksheet) As Variant Exit Function ErrorHandler: - Err.Raise 1005, "GetCSVHeader", "Invalid column letter in HeaderColumns: '" & colLetters(i) & "'" + Err.Raise ERR_CONFIG_INVALID, "GetCSVHeader", "Invalid column letter in HeaderColumns: '" & colLetters(i) & "'" End Function ' @@ -78,7 +78,7 @@ Function Contains(ByVal arr As Variant, ByVal value As String) As Boolean Contains = False End Function -' @return dict : key = keyCol,value = Array +' @return dict : key = keyCol, value = Array ' @param sheetName ' @param keyCol ' @param valueCols Array(4,5,6) @@ -87,19 +87,22 @@ Function LoadLookup(ByVal sheetName As String, ByVal cacheName As String) As Obj On Error GoTo ErrHandler ' --- validate --- - If Trim(sheetName) = "" Then Err.Raise 0001, "LoadLookup", "Sheet name cannot be empty." + If Trim(sheetName) = "" Then Err.Raise ERR_CONFIG_EMPTY_PARAM, "LoadLookup", "Sheet name cannot be empty." Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() If Not sheetConfDict.Exists(sheetName) Then - Err.Raise 1004, "LoadLookup", "Sheet not configured: " & sheetName + Err.Raise ERR_CONFIG_NOT_FOUND, "LoadLookup", "Sheet not configured: " & sheetName End If ' --- obtain worksheet --- + Dim ws As Worksheet On Error Resume Next - Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(sheetName) - If ws Is Nothing Then Err.Raise 0003, "LoadLookup", "Worksheet named '" & sheetName & "' not found." + Set ws = ThisWorkbook.Worksheets(sheetName) On Error GoTo ErrHandler - + If ws Is Nothing Then + Err.Raise ERR_SHEET_MISSING, "LoadLookup", "Worksheet '" & sheetName & "' not found." + End If + Dim sheetConf As Object: Set sheetConf = sheetConfDict(cacheName) Dim startRow As Long: startRow = sheetConf("StartRow") Dim keyCol As Long: keyCol = sheetConf("KeyCol") @@ -119,16 +122,20 @@ Function LoadLookup(ByVal sheetName As String, ByVal cacheName As String) As Obj End If Dim nValCols As Long: nValCols = UBound(valueCols) - LBound(valueCols) + 1 - If nValCols = 0 Then Err.Raise 0002, "LoadLookup", "Value columns parameter is invalid." + If nValCols = 0 Then Err.Raise ERR_CONFIG_EMPTY_PARAM, "LoadLookup", "Value columns parameter is invalid." ' --- prepare col --- Dim minCol As Long: minCol = keyCol Dim maxCol As Long: maxCol = keyCol Dim i As Long For i = LBound(valueCols) To UBound(valueCols) - If Not IsNumeric(valueCols(i)) Then Exit Function + If Not IsNumeric(valueCols(i)) Then + Err.Raise ERR_CONFIG_INVALID, "LoadLookup", "Value column is not numeric at index " & i + End If Dim colNum As Long: colNum = CLng(valueCols(i)) - If colNum < 1 Then Exit Function + If colNum < 1 Then + Err.Raise ERR_CONFIG_INVALID, "LoadLookup", "Value column must be >= 1, got " & colNum + End If If colNum < minCol Then minCol = colNum If colNum > maxCol Then maxCol = colNum Next i @@ -203,12 +210,12 @@ Function GetLastDataRowInRange(ws As Worksheet) As Long GetLastDataRowInRange = maxRow Else - Err.Raise 1004, "GetLastDataRowInRange", "Sheet not configured: " & ws.CodeName + Err.Raise ERR_CONFIG_NOT_FOUND, "GetLastDataRowInRange", "Sheet not configured: " & ws.CodeName End If Exit Function InvalidColumn: - Err.Raise 1005, "GetLastDataRowInRange", "Invalid column letter for sheet: " & ws.CodeName + Err.Raise ERR_CONFIG_INVALID, "GetLastDataRowInRange", "Invalid column letter for sheet: " & ws.CodeName End Function Function ClearDataRow(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endCol As Long, ByVal rowRow As Long, Optional ByVal errorCol As Long = 2) @@ -225,7 +232,7 @@ Sub ClearDataRows(ByVal ws As Worksheet) Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() ' If Not sheetConfDict.Exists(ws.CodeName) Then - Err.Raise 1004, "ClearDataRows", "Sheet not configured: " & ws.CodeName + Err.Raise ERR_CONFIG_NOT_FOUND, "ClearDataRows", "Sheet not configured: " & ws.CodeName End If Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) diff --git a/src/sh/tuk/module/Common_Global_Cache.bas b/src/sh/tuk/module/Common_Global_Cache.bas index 125d47d..c74b164 100644 --- a/src/sh/tuk/module/Common_Global_Cache.bas +++ b/src/sh/tuk/module/Common_Global_Cache.bas @@ -29,7 +29,7 @@ Public Function GetCache(ByVal cacheName As String) As Object Dim cache As Object Set cache = GlobalCache(cacheName) If cache.Count = 0 Then - Err.Raise 1001, "GetCache", "No cached data found for '" & cacheName & "'. Please load the cache first." + Err.Raise ERR_CACHE_NOT_FOUND, "GetCache", "No cached data found for '" & cacheName & "'. Please load the cache first." End If Set GetCache = cache @@ -38,8 +38,6 @@ End Function ' before RefreshCache, should validate Public Sub RefreshCache(ByVal cacheName As String) - On Error GoTo RefreshError - If GlobalCache Is Nothing Then InitCacheManager If Not GlobalCache.Exists(cacheName) Then Set GlobalCache(cacheName) = CreateObject("Scripting.Dictionary") @@ -56,24 +54,19 @@ Public Sub RefreshCache(ByVal cacheName As String) Set loadedData = LookupO1Cache() ElseIf Contains(sheetConfDict("Enum"), cacheName) Then Set loadedData = LoadLookup("Enum", cacheName) - Else + Else Set loadedData = LoadLookup(cacheName, cacheName) End If If Not loadedData Is Nothing Then Set GlobalCache(cacheName) = loadedData End If - - Exit Sub - -RefreshError: - Err.Raise 1001, "RefreshCache", "Failed to load " & cacheName & " lookup cache: " & Err.Description End Sub ' Refresh M1_KukanD cache - nested dict {D: {F: [G]}} -' Structure: { 交通機関区分[D]: { 利用区間発名[F]: [利用区間着名G] } } +' Structure: { Transport type [D]: { Station from [F]: [Station to G] } } Private Function LookupM1KukanCache() - Dim resultCache As Object + Dim resultCache As Object Set resultCache = CreateObject("Scripting.Dictionary") On Error GoTo ErrHandler @@ -82,17 +75,13 @@ Private Function LookupM1KukanCache() On Error Resume Next Set ws = ThisWorkbook.Worksheets("M1") On Error GoTo ErrHandler - - If ws Is Nothing Then - Set LookupM1KukanCache = resultCache - Exit Function - End If + ' ws exists, continue Dim sheetConf As Object: Set sheetConf = sheetConfDict("M1") Dim startRow As Long: startRow = sheetConf("StartRow") Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws) - If lastRow < startRow Then - Set LookupM2Cache = resultCache + If lastRow < startRow Then + Set LookupM1KukanCache = resultCache Exit Function End If @@ -104,13 +93,13 @@ Private Function LookupM1KukanCache() If dValue = "" Or fValue = "" Then GoTo NextRow2 - ' Outer level: D column (交通機関区分) + ' D column (transport type) If Not resultCache.Exists(dValue) Then Dim innerDict As Object: Set innerDict = CreateObject("Scripting.Dictionary") resultCache.Add dValue, innerDict End If - ' Inner level: F column (利用区間発名) -> array of G values + ' F column (station from) -> array of G values Set innerDict = resultCache(dValue) If Not innerDict.Exists(fValue) Then Dim arr As Object: Set arr = CreateObject("Scripting.Dictionary") @@ -129,15 +118,19 @@ NextRow2: Exit Function ErrHandler: - Err.Raise Err.Number, Err.Source, Err.Description + If Err.Number = 9 Then ' Subscript out of range (sheet not found) + Err.Raise ERR_SHEET_MISSING, "LookupM1KukanCache", "Sheet 'M1' not found." + Else + Err.Raise ERR_CACHE_NOT_FOUND, "LookupM1KukanCache", "Failed to load M1Kukan cache: " & Err.Description + End If End Function ' ============================================================ ' M2 Cache - Nested Dictionary -' Structure: { 区間コード[C]: { 券種[I]: { コード[J]: K } } } +' Structure: { Section code [C]: { Ticket type [I]: { Code [J]: K } } } ' ============================================================ Private Function LookupM2Cache() As Object - Dim resultCache As Object + Dim resultCache As Object Set resultCache = CreateObject("Scripting.Dictionary") On Error GoTo ErrHandler @@ -146,11 +139,7 @@ Private Function LookupM2Cache() As Object On Error Resume Next Set ws = ThisWorkbook.Worksheets("M2") On Error GoTo ErrHandler - - If ws Is Nothing Then - Set LookupM2Cache = resultCache - Exit Function - End If + ' ws exists, continue Dim sheetConf As Object: Set sheetConf = sheetConfDict("M2") Dim startRow As Long: startRow = sheetConf("StartRow") @@ -195,25 +184,27 @@ NextRow: Exit Function ErrHandler: - Err.Raise Err.Number, Err.Source, Err.Description + If Err.Number = 9 Then + Err.Raise ERR_SHEET_MISSING, "LookupM2Cache", "Sheet 'M2' not found." + Else + Err.Raise ERR_CACHE_NOT_FOUND, "LookupM2Cache", "Failed to load M2 cache: " & Err.Description + End If End Function ' ============================================================ ' O1 Cache ' ============================================================ Private Function LookupO1Cache() As Object - Dim resultCache As Object + Dim resultCache As Object Set resultCache = CreateObject("Scripting.Dictionary") + On Error GoTo ErrHandler + Dim ws As Worksheet On Error Resume Next Set ws = ThisWorkbook.Worksheets("O1") On Error GoTo ErrHandler - - If ws Is Nothing Then - Set LookupO1Cache = resultCache - Exit Function - End If + ' ws exists, continue Dim sheetConf As Object: Set sheetConf = sheetConfDict("O1") Dim startRow As Long: startRow = sheetConf("StartRow") @@ -261,7 +252,11 @@ NextO1: Exit Function ErrHandler: - Err.Raise Err.Number, Err.Source, Err.Description + If Err.Number = 9 Then + Err.Raise ERR_SHEET_MISSING, "LookupO1Cache", "Sheet 'O1' not found." + Else + Err.Raise ERR_CACHE_NOT_FOUND, "LookupO1Cache", "Failed to load O1 cache: " & Err.Description + End If End Function Private Sub RefreshSheetDict() diff --git a/src/sh/tuk/sheet/C1.cls b/src/sh/tuk/sheet/C1.cls index cedff26..9e01982 100644 --- a/src/sh/tuk/sheet/C1.cls +++ b/src/sh/tuk/sheet/C1.cls @@ -590,7 +590,8 @@ End Sub ' Validation logic 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) @@ -843,4 +844,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As End If Me.Cells(rowNum, errorCol).ClearContents + Exit Sub + +ErrHandler: + lastErrorMsg = Err.Description End Sub diff --git a/src/sh/tuk/sheet/M1.cls b/src/sh/tuk/sheet/M1.cls index 6d21ed7..505d27a 100644 --- a/src/sh/tuk/sheet/M1.cls +++ b/src/sh/tuk/sheet/M1.cls @@ -47,7 +47,8 @@ Private Sub Worksheet_Change(ByVal Target As Range) End Sub Private 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) @@ -129,15 +130,18 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As ' Validation passed - clear error ws.Cells(rowNum, errorCol).ClearContents + Exit Sub + +ErrHandler: + lastErrorMsg = Err.Description End Sub ' obtain z1 master data, and update column E Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long) Dim z1Cache As Object: Set z1Cache = GetCache("Z1") - If z1Cache Is Nothing Then Exit Sub Application.EnableEvents = False - On Error GoTo Finally + On Error GoTo ErrorHandler Dim r As Long For r = startRow To lastDataRow @@ -148,8 +152,11 @@ Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow A End If Next r -Finally: + Exit Sub + +ErrorHandler: Application.EnableEvents = True + Err.Raise ERR_CACHE_NOT_FOUND, "M1.Refresh", "Failed to refresh M1: " & Err.Description End Sub Private Sub ValidateWarn(ws As Worksheet, ByVal lastDataRow As Long) diff --git a/src/sh/tuk/sheet/M2.cls b/src/sh/tuk/sheet/M2.cls index 81b2191..f0de2f6 100644 --- a/src/sh/tuk/sheet/M2.cls +++ b/src/sh/tuk/sheet/M2.cls @@ -222,7 +222,8 @@ Private Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) 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) @@ -362,7 +363,10 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Next i ws.Cells(rowNum, errorCol).ClearContents + Exit Sub +ErrHandler: + lastErrorMsg = Err.Description End Sub Public Sub ImportCSVAndTriggerChange(ws As Worksheet, ByVal lastDataRow As Long) @@ -379,10 +383,9 @@ End Sub ' obtain T1/T2/T3 cache data, and update column K Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long) Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList") - If kenshuList Is Nothing Then Exit Sub Application.EnableEvents = False - On Error GoTo Finally + On Error GoTo ErrorHandler Dim r As Long For r = startRow To lastDataRow @@ -405,6 +408,9 @@ Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow A NextRow: Next r -Finally: + Exit Sub + +ErrorHandler: Application.EnableEvents = True + Err.Raise ERR_CACHE_NOT_FOUND, "M2.Refresh", "Failed to refresh M2: " & Err.Description End Sub diff --git a/src/sh/tuk/sheet/O1.cls b/src/sh/tuk/sheet/O1.cls index 7ccc10d..0276b40 100644 --- a/src/sh/tuk/sheet/O1.cls +++ b/src/sh/tuk/sheet/O1.cls @@ -14,4 +14,10 @@ Private Sub Worksheet_Change(ByVal Target As Range) 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/O2.cls b/src/sh/tuk/sheet/O2.cls index 01c74e8..8cfc547 100644 --- a/src/sh/tuk/sheet/O2.cls +++ b/src/sh/tuk/sheet/O2.cls @@ -15,4 +15,10 @@ Private Sub Worksheet_Change(ByVal Target As Range) 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 \ No newline at end of file diff --git a/src/sh/tuk/sheet/T1.cls b/src/sh/tuk/sheet/T1.cls index a4895c8..64891cd 100644 --- a/src/sh/tuk/sheet/T1.cls +++ b/src/sh/tuk/sheet/T1.cls @@ -17,7 +17,8 @@ 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) @@ -62,4 +63,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As If checkResult = False Then Exit Sub ws.Cells(rowNum, errorCol).ClearContents + Exit Sub + +ErrHandler: + lastErrorMsg = Err.Description End Sub diff --git a/src/sh/tuk/sheet/T2.cls b/src/sh/tuk/sheet/T2.cls index 0734937..af22fb2 100644 --- a/src/sh/tuk/sheet/T2.cls +++ b/src/sh/tuk/sheet/T2.cls @@ -17,7 +17,8 @@ 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) @@ -122,4 +123,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As If checkResult = False Then Exit Sub ws.Cells(rowNum, errorCol).ClearContents + Exit Sub + +ErrHandler: + lastErrorMsg = Err.Description End Sub diff --git a/src/sh/tuk/sheet/T3.cls b/src/sh/tuk/sheet/T3.cls index 18a7da0..153a46a 100644 --- a/src/sh/tuk/sheet/T3.cls +++ b/src/sh/tuk/sheet/T3.cls @@ -17,7 +17,8 @@ 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) @@ -82,4 +83,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As If checkResult = False Then Exit Sub ws.Cells(rowNum, errorCol).ClearContents + Exit Sub + +ErrHandler: + lastErrorMsg = Err.Description End Sub diff --git a/src/sh/tuk/sheet/Z1.cls b/src/sh/tuk/sheet/Z1.cls index 4924605..3dd78ff 100644 --- a/src/sh/tuk/sheet/Z1.cls +++ b/src/sh/tuk/sheet/Z1.cls @@ -17,7 +17,8 @@ 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) @@ -72,4 +73,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As If checkResult = False Then Exit Sub ws.Cells(rowNum, errorCol).ClearContents + Exit Sub + +ErrHandler: + lastErrorMsg = Err.Description End Sub diff --git a/src/sh/tuk/sheet/Z2.cls b/src/sh/tuk/sheet/Z2.cls index dc7e094..241c410 100644 --- a/src/sh/tuk/sheet/Z2.cls +++ b/src/sh/tuk/sheet/Z2.cls @@ -17,7 +17,8 @@ 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) @@ -62,4 +63,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As If checkResult = False Then Exit Sub ws.Cells(rowNum, errorCol).ClearContents + Exit Sub + +ErrHandler: + lastErrorMsg = Err.Description End Sub diff --git a/src/sh/tuk/sheet/Z3.cls b/src/sh/tuk/sheet/Z3.cls index 551fa7c..39f2f45 100644 --- a/src/sh/tuk/sheet/Z3.cls +++ b/src/sh/tuk/sheet/Z3.cls @@ -17,6 +17,8 @@ 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) @@ -65,4 +67,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As If checkResult = False Then Exit Sub ws.Cells(rowNum, errorCol).ClearContents + Exit Sub + +ErrHandler: + lastErrorMsg = Err.Description End Sub diff --git a/src/sh/tuk/sheet/Z4.cls b/src/sh/tuk/sheet/Z4.cls index 2643310..00b3d77 100644 --- a/src/sh/tuk/sheet/Z4.cls +++ b/src/sh/tuk/sheet/Z4.cls @@ -17,6 +17,8 @@ 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) @@ -69,4 +71,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As If checkResult = False Then Exit Sub ws.Cells(rowNum, errorCol).ClearContents + Exit Sub + +ErrHandler: + lastErrorMsg = Err.Description End Sub diff --git a/通勤手当テンプレート20260515.xlsm b/通勤手当テンプレート20260515.xlsm index 36de47d..c858a16 100644 Binary files a/通勤手当テンプレート20260515.xlsm and b/通勤手当テンプレート20260515.xlsm differ