updsv7/vba
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

20260515指摘対応6

Browse Source
This commit is contained in:
guanxiangwei
2026-05-20 18:46:15 +09:00
parent b25db7d99c
commit 5b4ffe87aa
18 changed files with 259 additions and 185 deletions
Download Patch File Download Diff File Expand all files Collapse all files

190
src/sh/tuk/module/Common_Button.bas
View File

@@ -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