422 lines
14 KiB
QBasic
422 lines
14 KiB
QBasic
Attribute VB_Name = "Common_Button"
|
|
Option Explicit
|
|
|
|
' --- Private Variables ---
|
|
Private m_LastErrorMsg As String
|
|
|
|
' ============================================================
|
|
' Get/Set last error message
|
|
' ============================================================
|
|
Public Sub SetLastErrorMsg(msg As String)
|
|
m_LastErrorMsg = msg
|
|
End Sub
|
|
|
|
Public Function GetLastErrorMsg() As String
|
|
GetLastErrorMsg = m_LastErrorMsg
|
|
End Function
|
|
|
|
Public Sub ClearLastErrorMsg()
|
|
m_LastErrorMsg = ""
|
|
End Sub
|
|
|
|
' ============================================================
|
|
' Module Name: Common_Button
|
|
' Module Desc: Common button handlers with centralized error handling
|
|
' Public Methods:
|
|
' - CSV_Import_Button (CSV import entry, binds to sheet button)
|
|
' - Validation_Button (validation entry, binds to sheet button)
|
|
' - CSV_Export_Button (CSV export entry, binds to sheet button)
|
|
' - Sort_Button (sort entry, binds to sheet button)
|
|
' - Filter_Button (filter entry, binds to sheet button)
|
|
' - Fit_Button (autofit column width, binds to sheet button)
|
|
' - RefreshCache_Button (refresh master cache)
|
|
' - RunValidationSilent (validate sheet, returns row count or -1)
|
|
' - HandleError (centralized error handler)
|
|
' Private Methods:
|
|
' - ValidateKukanCache
|
|
' - UpdateByMaster
|
|
' - Fit_Button
|
|
' ============================================================
|
|
|
|
Sub RefreshCache_Button()
|
|
On Error GoTo ErrorHandler
|
|
Dim activeSheetName As String: activeSheetName = ActiveSheet.CodeName
|
|
|
|
Debug.Print "1. Validate Z1~Z4, T1~T3, O1~O3 master data"
|
|
Dim cacheSheets As Variant: cacheSheets = Array(CACHE_Z1, CACHE_Z2, CACHE_Z3, CACHE_Z4, CACHE_T1, CACHE_T2, CACHE_T3, CACHE_O1, CACHE_O2, CACHE_O3)
|
|
Dim sheetName As Variant
|
|
Dim ws As Worksheet
|
|
For Each sheetName In cacheSheets
|
|
Set ws = ThisWorkbook.Worksheets(CStr(sheetName))
|
|
Dim result As Long: result = RunValidationSilent(ws)
|
|
If result = 0 Then
|
|
Err.Raise ERR_CACHE_EMPTY, "RefreshCache_Button", sheetName & " sheet has no data."
|
|
End If
|
|
If result < 0 Then
|
|
Err.Raise ERR_CACHE_EMPTY, "RefreshCache_Button", "Can't refresh " & sheetName & " cache. Validation error occurs."
|
|
End If
|
|
Next sheetName
|
|
|
|
Debug.Print "2. refresh master data"
|
|
Call RefreshMasterCache()
|
|
|
|
Debug.Print "3. Determine which cache sheets to refresh based on ActiveSheet"
|
|
If activeSheetName = "C1" Then
|
|
' first is M1
|
|
Call ValidateKukanCache("M1")
|
|
Call RefreshKukanCache("M1")
|
|
Call UpdateByMaster("M1")
|
|
' second is M2
|
|
Call ValidateKukanCache("M2")
|
|
Call RefreshKukanCache("M2")
|
|
Call UpdateByMaster("M2")
|
|
ElseIf activeSheetName = "M2" Then
|
|
Call ValidateKukanCache("M1")
|
|
Call RefreshKukanCache("M1")
|
|
Call UpdateByMaster("M1")
|
|
End If
|
|
|
|
Debug.Print "4. update content by other master data"
|
|
Call UpdateByMaster(activeSheetName)
|
|
|
|
Exit Sub
|
|
|
|
ErrorHandler:
|
|
Debug.Print "sheetName = " & sheetName
|
|
HandleError "RefreshCache_Button"
|
|
End Sub
|
|
|
|
Private Sub ValidateKukanCache(ByVal sheetName As String)
|
|
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(CStr(sheetName))
|
|
Dim result As Long: result = RunValidationSilent(ws)
|
|
|
|
If result = 0 Then
|
|
Err.Raise ERR_CACHE_EMPTY, "ValidateKukanCache", sheetName & " sheet has no data."
|
|
End If
|
|
|
|
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)
|
|
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(CStr(sheetName))
|
|
|
|
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
|
Dim sheetConf As Object: Set sheetConf = sheetConfDict(sheetName)
|
|
Dim startRow As Long: startRow = sheetConf("StartRow")
|
|
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
|
|
Application.Run sheetName & ".Refresh", ws, startRow, lastDataRow
|
|
End Sub
|
|
|
|
' ============================================================
|
|
' CSV Import entry point (binds to sheet button)
|
|
' ============================================================
|
|
Public Sub CSV_Import_Button()
|
|
Dim ws As Worksheet: Set ws = ActiveSheet
|
|
On Error GoTo ErrorHandler
|
|
|
|
' Step 1: get csv encoding
|
|
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
|
Dim cfg As Object: Set cfg = sheetConfDict(ws.CodeName)
|
|
Dim expectedColumnCount As Long: expectedColumnCount = cfg("ExpectedColumnCount")
|
|
|
|
' Step 2: Select CSV file
|
|
Dim filePath As String: filePath = SelectCSVFile()
|
|
If filePath = "" Then Exit Sub
|
|
|
|
' 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) Or UBound(csvData, 1) < 1 Then
|
|
Err.Raise ERR_FILE_EMPTY, "DO_CSV_Import", "No data in CSV."
|
|
End If
|
|
|
|
' === Step 4: Clear all data rows before import ===
|
|
Application.ScreenUpdating = False
|
|
Application.EnableEvents = False
|
|
Call ClearDataRows(ws)
|
|
|
|
' === 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
|
|
For i = LBound(csvData, 1) To UBound(csvData, 1)
|
|
Dim j As Long
|
|
For j = 0 To expectedColumnCount - 1
|
|
ws.Cells(writeRow, ws.Range(colLetters(j) & "1").Column).Value = CleanCSVField(CStr(csvData(i, j + 1)))
|
|
Next j
|
|
If cfg.Exists("DisplayCol") Then
|
|
Call BuildDisplayDropdown(ws, writeRow)
|
|
End If
|
|
writeRow = writeRow + 1
|
|
Next i
|
|
|
|
MsgBox writeRow - cfg("StartRow") & " rows imported.", vbInformation
|
|
GoTo FinallyExit
|
|
|
|
ErrorHandler:
|
|
HandleError "DO_CSV_Import"
|
|
GoTo FinallyExit
|
|
|
|
FinallyExit:
|
|
Application.EnableEvents = True
|
|
Application.ScreenUpdating = True
|
|
End Sub
|
|
|
|
' ============================================================
|
|
' Do_Validation entry point (binds to sheet button)
|
|
' ============================================================
|
|
Public Sub Validation_Button()
|
|
Dim ws As Worksheet: Set ws = ActiveSheet
|
|
On Error GoTo ErrorHandler
|
|
Application.EnableEvents = False
|
|
|
|
Dim result As Long: result = RunValidationSilent(ws)
|
|
|
|
If result = -1 Then
|
|
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
|
|
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
|
|
Application.Run "M1.ValidateWarn", ws, lastDataRow
|
|
End If
|
|
|
|
Do_Fit_Internal ws
|
|
Application.EnableEvents = True
|
|
Exit Sub
|
|
|
|
ErrorHandler:
|
|
Application.EnableEvents = True
|
|
HandleError "Do_Validation"
|
|
Do_Fit_Internal ws
|
|
|
|
End Sub
|
|
|
|
' ============================================================
|
|
' CSV Export entry point (binds to sheet button)
|
|
' ============================================================
|
|
Public Sub CSV_Export_Button()
|
|
Dim ws As Worksheet: Set ws = ActiveSheet
|
|
On Error GoTo ErrorHandler
|
|
|
|
' === Step 1: Validate all rows before export ===
|
|
Dim result As Long: result = RunValidationSilent(ws)
|
|
|
|
If result = 0 Then
|
|
Err.Raise ERR_CACHE_EMPTY, "DO_CSV_Export", "No data rows to output."
|
|
End If
|
|
|
|
If result < 0 Then
|
|
Err.Raise ERR_VALIDATION_FAILED, "DO_CSV_Export", "Validation failed. Export aborted."
|
|
End If
|
|
|
|
' === Step 2: Select save path ===
|
|
Dim savePath As String: savePath = GetSaveCSVPath()
|
|
If savePath = "" Then Exit Sub
|
|
|
|
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
|
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
|
|
|
' === Step 3: Count data rows ===
|
|
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
|
|
Dim startRow As Long: startRow = sheetConf("StartRow")
|
|
Dim rowCount As Long: rowCount = lastDataRow - startRow + 1
|
|
|
|
' === Step 4: Count data columns ===
|
|
Dim expectedColumnCount As Long: expectedColumnCount = sheetConf("ExpectedColumnCount")
|
|
|
|
' === Step 5: check export csv has header ===
|
|
Dim hasHeader As Boolean: hasHeader = sheetConf("HasHeader")
|
|
Dim dataRow As Long: dataRow = 1
|
|
Dim outputArr As Variant
|
|
|
|
If hasHeader Then
|
|
ReDim outputArr(1 To rowCount + 1, 1 To expectedColumnCount)
|
|
Else
|
|
ReDim outputArr(1 To rowCount, 1 To expectedColumnCount)
|
|
End If
|
|
|
|
' === Step 6: Build array with header and data ===
|
|
If hasHeader Then
|
|
Dim headerArr As Variant
|
|
headerArr = GetCSVHeader(ws)
|
|
|
|
Dim colIdx As Long
|
|
For colIdx = 0 To expectedColumnCount - 1
|
|
outputArr(1, colIdx + 1) = headerArr(1, colIdx + 1)
|
|
Next colIdx
|
|
dataRow = dataRow + 1
|
|
End If
|
|
|
|
Dim colLetters As Variant: colLetters = sheetConf("HeaderColumns")
|
|
Dim r As Long
|
|
Dim colIndex As Long
|
|
For r = startRow To lastDataRow
|
|
For colIdx = 0 To expectedColumnCount - 1
|
|
colIndex = Columns(colLetters(colIdx)).Column
|
|
outputArr(dataRow, colIdx + 1) = CleanCSVField(ws.Cells(r, colIndex).Value)
|
|
Next colIdx
|
|
dataRow = dataRow + 1
|
|
Next r
|
|
|
|
Call WriteCSVFromArray(savePath, outputArr, sheetConf("CSV_Encoding"), sheetConf("AlwaysQuote"))
|
|
|
|
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
|
|
Exit Sub
|
|
|
|
ErrorHandler:
|
|
HandleError "DO_CSV_Export"
|
|
End Sub
|
|
|
|
|
|
' ============================================================
|
|
' Do_Sort entry point (binds to sheet button)
|
|
' ============================================================
|
|
Public Sub Sort_Button()
|
|
Dim ws As Worksheet: Set ws = ActiveSheet
|
|
On Error GoTo ErrorHandler
|
|
|
|
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 startRow As Long: startRow = sheetConf("StartRow")
|
|
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
|
|
|
|
If lastDataRow < startRow Then
|
|
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))
|
|
Application.Goto sortRange
|
|
Application.Dialogs(xlDialogSort).Show
|
|
Exit Sub
|
|
|
|
ErrorHandler:
|
|
HandleError "Do_Sort"
|
|
End Sub
|
|
|
|
|
|
' ============================================================
|
|
' Do_Filter entry point (binds to sheet button)
|
|
' ============================================================
|
|
Public Sub Filter_Button()
|
|
Dim ws As Worksheet: Set ws = ActiveSheet
|
|
On Error GoTo ErrorHandler
|
|
|
|
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
|
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
|
|
|
' Check if auto filter is already on
|
|
If ws.AutoFilterMode Then
|
|
ws.AutoFilterMode = False
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim startCol As Long: startCol = ws.Range(sheetConf("ErrorCol") & "1").Column
|
|
Dim endCol As Long: endCol = ws.Range(sheetConf("EndCol") & "1").Column
|
|
|
|
Dim filterRow As Long: filterRow = sheetConf("FilterRow")
|
|
|
|
Dim filterRange As Range: Set filterRange = ws.Range(ws.Cells(filterRow, startCol), ws.Cells(filterRow, endCol))
|
|
filterRange.AutoFilter
|
|
Exit Sub
|
|
|
|
ErrorHandler:
|
|
HandleError "Do_Filter"
|
|
End Sub
|
|
|
|
Public Sub Fit_Button()
|
|
Do_Fit_Internal ActiveSheet
|
|
End Sub
|
|
|
|
' ============================================================
|
|
' Do_Fit internal implementation
|
|
' ============================================================
|
|
Private Sub Do_Fit_Internal(ws As Excel.Worksheet)
|
|
On Error GoTo ErrorHandler
|
|
|
|
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
|
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
|
|
|
' adjust width function contains error column
|
|
Dim startCol As String: startCol = sheetConf("ErrorCol")
|
|
Dim endCol As String: endCol = sheetConf("EndCol")
|
|
|
|
ws.Columns(startCol & ":" & endCol).AutoFit
|
|
Exit Sub
|
|
|
|
ErrorHandler:
|
|
HandleError "Do_Fit"
|
|
End Sub
|
|
|
|
' ============================================================
|
|
' RunValidationSilent
|
|
' 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)
|
|
|
|
Dim validate As String: validate = ws.CodeName & ".Validate"
|
|
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
|
|
Dim startRow As Long: startRow = sheetConf("StartRow")
|
|
Dim errorCol As Long: errorCol = ws.Range(sheetConf("ErrorCol") & "1").Column
|
|
|
|
If lastDataRow < startRow Then
|
|
RunValidationSilent = 0
|
|
Exit Function
|
|
End If
|
|
|
|
Dim r As Long
|
|
Dim hasError As Boolean: hasError = False
|
|
For r = startRow To lastDataRow
|
|
SetLastErrorMsg ""
|
|
Application.Run validate, ws, r, lastDataRow
|
|
If GetLastErrorMsg() <> "" Then
|
|
Err.Raise ERR_VALIDATION_FAILED, "RunValidationSilent", GetLastErrorMsg()
|
|
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
|
|
End If
|
|
Next r
|
|
|
|
If hasError = True Then
|
|
RunValidationSilent = -1
|
|
Exit Function
|
|
End If
|
|
|
|
RunValidationSilent = lastDataRow - startRow + 1
|
|
Exit Function
|
|
End Function
|
|
|
|
' ============================================================
|
|
' Error Handlers
|
|
' ============================================================
|
|
|
|
' 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
|