refactor
This commit is contained in:
updsv7
359
src/sh/tuk/module/Common_Button.bas
Normal file
359
src/sh/tuk/module/Common_Button.bas
Normal file
@@ -0,0 +1,359 @@
|
||||
Attribute VB_Name = "Common_Button"
|
||||
Option Explicit
|
||||
' ============================================================
|
||||
' Module Name: Common_Button
|
||||
' Module Desc: Common_Button
|
||||
' Module Methods:
|
||||
' - CSV_Import_Button
|
||||
' ============================================================
|
||||
Sub CSV_Import_Button()
|
||||
DO_CSV_Import ActiveSheet
|
||||
End Sub
|
||||
|
||||
Sub Validation_Button()
|
||||
Do_Validation ActiveSheet
|
||||
End Sub
|
||||
|
||||
Sub CSV_Export_Button()
|
||||
DO_CSV_Export ActiveSheet
|
||||
End Sub
|
||||
|
||||
Sub Sort_Button()
|
||||
Do_Sort ActiveSheet
|
||||
End Sub
|
||||
|
||||
Sub Filter_Button()
|
||||
Do_Filter ActiveSheet
|
||||
End Sub
|
||||
|
||||
Sub Fit_Button()
|
||||
Do_Fit ActiveSheet
|
||||
End Sub
|
||||
|
||||
Sub RefreshCache_Button()
|
||||
Dim cacheSheets As Variant: cacheSheets = Array("M1", "M2", "Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1","O2")
|
||||
|
||||
Dim sheetName As Variant
|
||||
Dim ws As Worksheet
|
||||
For Each sheetName In cacheSheets
|
||||
If ProcedureExists(sheetName, "Validate") Then
|
||||
Dim errorCount As Long
|
||||
On Error Resume Next
|
||||
Set ws = ThisWorkbook.Worksheets(CStr(sheetName))
|
||||
On Error GoTo 0
|
||||
Dim isValid As Boolean: isValid = RunValidationSilent(ws, errorCount)
|
||||
If isValid = False Then
|
||||
MsgBox "Can't refresh " & sheetName & " cache. Validation error occurs."
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
Next sheetName
|
||||
|
||||
Dim result As Boolean: result = RefreshAllCache()
|
||||
If result = True Then
|
||||
MsgBox "master data reload successfully."
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub DO_CSV_Import(ws As Excel.Worksheet)
|
||||
On Error GoTo ImportError
|
||||
|
||||
' 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) Then
|
||||
MsgBox "No valid data returned from CSV.", vbExclamation
|
||||
GoTo FinallyExit
|
||||
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 ===
|
||||
Application.ScreenUpdating = False
|
||||
Application.EnableEvents = False
|
||||
Call ClearDataRows(ws)
|
||||
|
||||
' === Step 4: 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
|
||||
|
||||
FinallyExit:
|
||||
Application.EnableEvents = True
|
||||
Application.ScreenUpdating = True
|
||||
End Sub
|
||||
|
||||
'
|
||||
Private Sub Do_Validation(ws As Excel.Worksheet)
|
||||
On Error GoTo ErrorHandler
|
||||
|
||||
' step1. confirm Validate Sub
|
||||
If Not ProcedureExists(ws.CodeName, "Validate") Then
|
||||
MsgBox "worksheet """ & ws.name & """ unimplement methods", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim errorCount As Long
|
||||
Dim isValid As Boolean: isValid = RunValidationSilent(ws, errorCount)
|
||||
|
||||
If errorCount = -1 Then
|
||||
MsgBox "worksheet """ & ws.Name & """ unimplement methods", vbExclamation
|
||||
ElseIf errorCount = -2 Then
|
||||
MsgBox "Validation error occurred.", vbCritical
|
||||
ElseIf errorCount > 0 Then
|
||||
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
|
||||
Else
|
||||
If ws.CodeName <> "C1" Then
|
||||
RefreshCache(ws.CodeName)
|
||||
End If
|
||||
MsgBox "Validation complete. Errors: 0", vbInformation
|
||||
End If
|
||||
|
||||
Exit Sub
|
||||
|
||||
ErrorHandler:
|
||||
MsgBox "Error: " & Err.Description, vbCritical
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
'
|
||||
Private Sub DO_CSV_Export(ws As Excel.Worksheet)
|
||||
On Error GoTo ExportError
|
||||
|
||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
||||
|
||||
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
|
||||
Dim startRow As Long: startRow = sheetConf("StartRow")
|
||||
|
||||
If lastDataRow < startRow Then
|
||||
MsgBox "No data rows to output.", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' === Step 1: Validate all rows before export ===
|
||||
' Do_Validation
|
||||
Dim errorCount As Long
|
||||
If Not RunValidationSilent(ws, errorCount) Then
|
||||
If errorCount > 0 Then
|
||||
MsgBox "Validation failed (" & errorCount & " errors). Export aborted.", vbCritical
|
||||
Exit Sub
|
||||
Else
|
||||
MsgBox "Validation setup error. Export aborted.", vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
|
||||
' === Step 2: Select save path ===
|
||||
Dim savePath As String: savePath = GetSaveCSVPath()
|
||||
If savePath = "" Then Exit Sub
|
||||
|
||||
' === Step 3: Count data rows ===
|
||||
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
|
||||
|
||||
' when has header + 1
|
||||
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
|
||||
For r = startRow To lastDataRow
|
||||
For colIdx = 0 To expectedColumnCount - 1
|
||||
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
|
||||
End Sub
|
||||
|
||||
Private Sub Do_Sort(ws As Excel.Worksheet)
|
||||
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
|
||||
MsgBox "No data to sort.", vbExclamation
|
||||
Exit Sub
|
||||
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))
|
||||
sortRange.Select
|
||||
|
||||
' Show sort dialog
|
||||
Application.Dialogs(xlDialogSort).Show
|
||||
Exit Sub
|
||||
|
||||
ErrorHandler:
|
||||
MsgBox "Error: " & Err.Description, vbCritical
|
||||
End Sub
|
||||
|
||||
Private Sub Do_Filter(ws As Excel.Worksheet)
|
||||
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("StartCol") & "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:
|
||||
MsgBox "Error: " & Err.Description, vbCritical
|
||||
End Sub
|
||||
|
||||
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)
|
||||
|
||||
Dim startCol As String: startCol = sheetConf("StartCol")
|
||||
Dim endCol As String: endCol = sheetConf("EndCol")
|
||||
|
||||
ws.Columns(startCol & ":" & endCol).AutoFit
|
||||
Exit Sub
|
||||
|
||||
ErrorHandler:
|
||||
MsgBox "Error: " & Err.Description, vbCritical
|
||||
End Sub
|
||||
|
||||
' RunValidationSilent
|
||||
Public Function RunValidationSilent(ws As Worksheet, Optional ByRef errorCountOut As Long = 0) As Boolean
|
||||
On Error GoTo ErrorHandler
|
||||
|
||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
||||
|
||||
' check Validate method exist
|
||||
If Not ProcedureExists(ws.CodeName, "Validate") Then
|
||||
errorCountOut = -1
|
||||
RunValidationSilent = False
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
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
|
||||
errorCountOut = 0
|
||||
RunValidationSilent = True
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim r As Long
|
||||
errorCountOut = 0
|
||||
For r = startRow To lastDataRow
|
||||
Application.Run validate, ws, r, lastDataRow
|
||||
Dim errorMessage As String : errorMessage = Trim(ws.Cells(r, errorCol).Value)
|
||||
Dim errorCode As String: errorCode = GetCode(errorMessage)
|
||||
If errorCode <> "W001" And errorCode <> "" Then
|
||||
errorCountOut = errorCountOut + 1
|
||||
End If
|
||||
Next r
|
||||
|
||||
RunValidationSilent = (errorCountOut = 0)
|
||||
Exit Function
|
||||
|
||||
ErrorHandler:
|
||||
errorCountOut = -2
|
||||
RunValidationSilent = False
|
||||
End Function
|
||||
|
||||
Public Function ProcedureExists(ByVal moduleName As String, ByVal procName As String) As Boolean
|
||||
Dim VBProj As Object, VBComp As Object, CodeMod As Object
|
||||
|
||||
On Error Resume Next
|
||||
|
||||
Set VBProj = ThisWorkbook.VBProject
|
||||
Set VBComp = VBProj.VBComponents(moduleName)
|
||||
If Not VBComp Is Nothing Then
|
||||
Set CodeMod = VBComp.CodeModule
|
||||
ProcedureExists = (CodeMod.ProcStartLine(procName, 0) > 0)
|
||||
End If
|
||||
|
||||
If Err.Number <> 0 Then ProcedureExists = False
|
||||
On Error GoTo 0
|
||||
End Function
|
||||
Reference in New Issue
Block a user