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

20260515指摘対応5

Browse Source
This commit is contained in:
guanxiangwei
2026-05-20 14:33:18 +09:00
parent b359ae916b
commit b25db7d99c
9 changed files with 348 additions and 198 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -31,58 +31,104 @@ Sub Fit_Button()
End Sub
Sub RefreshCache_Button()
On Error GoTo ErrorHandler
Dim exitMsg As String
Dim activeSheetName As String: activeSheetName = ActiveSheet.CodeName
' Determine which cache sheets to refresh based on ActiveSheet
Dim cacheSheets As Variant
If activeSheetName = "C1" Then
cacheSheets = Array("M1", "M2", "Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2")
ElseIf activeSheetName = "M1" Then
cacheSheets = Array("Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2")
ElseIf activeSheetName = "M2" Then
cacheSheets = Array("M1", "Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2")
Else
MsgBox "This sheet does not support cache refresh.", vbExclamation
Exit Sub
End If
' Validate and refresh cache
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")
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
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
' Refresh cache based on activeSheet
Dim result As Boolean: result = RefreshAllCache(activeSheetName)
If result = True Then
' Call active sheet's Refresh method
If ProcedureExists(activeSheetName, "Refresh") Then
On Error Resume Next
Set ws = ActiveSheet
On Error GoTo 0
If Not ws Is Nothing Then
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(activeSheetName)
Dim startRow As Long: startRow = sheetConf("StartRow")
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
Application.Run activeSheetName & ".Refresh", ws, startRow, lastDataRow
End If
Else
MsgBox "Sheet " & activeSheetName & " does not implement Refresh method.", vbExclamation
End If
Debug.Print "2. refresh master data"
Call RefreshMasterCache()
MsgBox "master data reload successfully."
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")
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:
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
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
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()
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
Exit Sub
ErrorHandler:
If exitMsg <> "" Then
MsgBox "UpdateByMaster: " & exitMsg, vbExclamation
Else
MsgBox "UpdateByMaster: " & Err.Description, vbExclamation
End If
End Sub
@@ -149,27 +195,28 @@ End Sub
'
Private Sub Do_Validation(ws As Excel.Worksheet)
On Error GoTo ErrorHandler
Dim exitMsg As String
' step1. confirm Validate Sub
If Not ProcedureExists(ws.CodeName, "Validate") Then
MsgBox "worksheet """ & ws.name & """ unimplement methods", vbExclamation
Exit Sub
End If
Dim result As Long: result = RunValidationSilent(ws)
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
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. Errors: 0", vbInformation
MsgBox "Validation complete. Success: " & result, vbInformation
End If
' 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 ws
@@ -177,43 +224,41 @@ Private Sub Do_Validation(ws As Excel.Worksheet)
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Description, vbCritical
Exit Sub
HandleError "Do_Validation"
' If exitMsg <> "" Then
' MsgBox "Do_Validation: " & exitMsg, vbExclamation
' Else
' MsgBox "Do_Validation: " & Err.Description, vbExclamation
' End If
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)
' === Step 1: Validate all rows before export ===
Dim result As Long: result = RunValidationSilent(ws)
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
Dim startRow As Long: startRow = sheetConf("StartRow")
If lastDataRow < startRow Then
If result = 0 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
If result < 0 Then
MsgBox "Validation failed. Export aborted.", vbCritical
Exit Sub
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 ===
@@ -333,61 +378,50 @@ ErrorHandler:
End Sub
' RunValidationSilent
Public Function RunValidationSilent(ws As Worksheet, Optional ByRef errorCountOut As Long = 0) As Boolean
On Error GoTo ErrorHandler
' Positive number = success (number of rows with no errors)
' 0 = no data
' -1 = has errors
' -2 = runtime error
Public Function RunValidationSilent(ws As Worksheet) As Long
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
RunValidationSilent = 0
Exit Function
End If
Dim r As Long
errorCountOut = 0
Dim hasError As Boolean: hasError = False
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
hasError = True
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)
If hasError = True Then
RunValidationSilent = -1
Exit Function
End If
If Err.Number <> 0 Then ProcedureExists = False
On Error GoTo 0
RunValidationSilent = lastDataRow - startRow + 1
Exit Function
End Function
Public Sub HandleError(sourceProcedure As String)
Dim msg As String
Select Case Err.Number
Case ERR_CACHE_EMPTY
msg = Err.Description
MsgBox msg, vbExclamation
End Select
End Sub

10
src/sh/tuk/module/Common_Constants.bas Normal file
View File

@@ -0,0 +1,10 @@
Attribute VB_Name = "Common_Constants"
Option Explicit
' ============================================================
' Module Name: Common_Constants
' Module Desc: Common_Constants
' Module Methods:
' ============================================================
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

139
src/sh/tuk/module/Common_Global_Cache.bas
View File

@@ -9,7 +9,7 @@ Option Explicit
' - RefreshO1Cache
' ============================================================
Private sheetConfDict As Object
Private FormulaCache As Object
Public GlobalCache As Object
Public Sub InitCacheManager()
@@ -20,65 +20,33 @@ Public Sub InitCacheManager()
End Sub
Public Function GetCache(ByVal cacheName As String) As Object
Dim cache As Object
Dim loadedData As Object
'
On Error GoTo RefreshError
'
If GlobalCache Is Nothing Then InitCacheManager
'
If Not GlobalCache.Exists(cacheName) Then
Set GlobalCache(cacheName) = CreateObject("Scripting.Dictionary")
GlobalCache(cacheName).CompareMode = vbTextCompare
End If
Dim cache As Object
Set cache = GlobalCache(cacheName)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
If cache.Count = 0 Then
If cacheName = "M1KukanDCache" Then
Set loadedData = LookupM1KukanCache()
ElseIf cacheName = "M2" Then
Set loadedData = LookupM2Cache()
ElseIf cacheName = "O1" Then
Set loadedData = LookupO1Cache()
ElseIf Contains(sheetConfDict("Enum"), cacheName) Then
Set loadedData = LoadLookup("Enum", cacheName)
Else
Set loadedData = LoadLookup(cacheName, cacheName)
End If
If Not loadedData Is Nothing Then
Set GlobalCache(cacheName) = loadedData
Set cache = loadedData
End If
Err.Raise 1001, "GetCache", "No cached data found for '" & cacheName & "'. Please load the cache first."
End If
Set GetCache = cache
Exit Function
RefreshError:
Err.Raise 1001, "GetCache", "Failed to load " & cacheName & " lookup cache: " & Err.Description
End Function
' before RefreshCache, should validate
Public Sub RefreshCache(ByVal cacheName As String)
Dim loadedData As Object
'
On Error GoTo RefreshError
'
If GlobalCache Is Nothing Then InitCacheManager
'
If Not GlobalCache.Exists(cacheName) Then
Set GlobalCache(cacheName) = CreateObject("Scripting.Dictionary")
GlobalCache(cacheName).CompareMode = vbTextCompare
End If
Dim loadedData As Object
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
If cacheName = "M1KukanDCache" Then
Set loadedData = LookupM1KukanCache()
@@ -573,6 +541,12 @@ Private Sub RefreshSheetDict()
Set sheetConfDict("errorList") = sheetConf
Debug.Print "RefreshSheetDict errorList ok."
' Caches
Set sheetConf = CreateObject("Scripting.Dictionary")
' TODO
Set sheetConfDict("Caches") = sheetConf
Debug.Print "RefreshSheetDict Caches ok."
Debug.Print "RefreshSheetDict end."
End Sub
@@ -581,32 +555,93 @@ Public Function GetSheetConfig() As Object
Set GetSheetConfig = sheetConfDict
End Function
Public Function RefreshAllCache(Optional ByVal activeSheetName As String = "") As Boolean
Public Sub RefreshMasterCache()
' Fixed cache names
Dim fixedCaches As Variant
fixedCaches = Array("Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2", _
"tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList")
' Dynamic cache names based on activeSheet
Dim dynamicCaches As Variant
If activeSheetName = "C1" Then
dynamicCaches = Array("M1", "M1KukanDCache", "M2")
ElseIf activeSheetName = "M2" Then
dynamicCaches = Array("M1", "M1KukanDCache")
Else
dynamicCaches = Array()
End If
' Refresh fixed caches
Dim cacheName As Variant
For Each cacheName In fixedCaches
Call RefreshCache(CStr(cacheName))
Call WriteCachesSheet(CStr(cacheName))
Next cacheName
End Sub
' Refresh dynamic caches
For Each cacheName In dynamicCaches
Call RefreshCache(CStr(cacheName))
Next cacheName
Public Sub RefreshKukanCache(ByVal sheetName As String)
If sheetName = "M1" Then
Call RefreshCache("M1")
Call RefreshCache("M1KukanDCache")
Call WriteCachesSheet("M1")
End If
If sheetName = "M2" Then
Call RefreshCache("M2")
Call WriteCachesSheet("M2")
End If
End Sub
RefreshAllCache = True
' Write cache data to Caches sheet for dropdown
Public Sub WriteCachesSheet(ByVal cacheName As String)
Dim wsCache As Worksheet
Set wsCache = ThisWorkbook.Sheets("Caches")
If wsCache Is Nothing Then
Set wsCache = ThisWorkbook.Sheets.Add
wsCache.Name = "Caches"
wsCache.Visible = xlVeryHidden
End If
' Map cacheName to column letter
Dim colLetter As String
Select Case cacheName
Case "Z1": colLetter = "A"
Case "Z2": colLetter = "B"
Case "Z3": colLetter = "C"
Case "Z4": colLetter = "D"
Case "T1": colLetter = "E"
Case "T2": colLetter = "F"
Case "T3": colLetter = "G"
Case "O1": colLetter = "H"
Case "O2": colLetter = "I"
Case Else: Exit Sub
End Select
Dim cache As Object: Set cache = GetCache(cacheName)
If cache Is Nothing Then Exit Sub
' Write to Caches sheet
wsCache.Columns(colLetter).ClearContents
Dim idx As Long: idx = 1
Dim key As Variant
For Each key In cache.Keys
If key <> 0 Then
Dim displayText As String: displayText = MakeSelect(key, cache(key)(0))
If displayText <> "" Then
wsCache.Cells(idx, colLetter).Value = displayText
idx = idx + 1
End If
End If
Next key
Dim lastRow As Long: lastRow = wsCache.Cells(wsCache.Rows.Count, colLetter).End(xlUp).Row
Dim formulaStr As String
If lastRow >= 1 Then
formulaStr = "=Caches!" & colLetter & "1:" & colLetter & lastRow
Else
formulaStr = "=Caches!" & colLetter & "1"
End If
' write into FormulaCache
If FormulaCache Is Nothing Then Set FormulaCache = CreateObject("Scripting.Dictionary")
FormulaCache(cacheName) = formulaStr
End Sub
Public Function GetValidationFormula(ByVal cacheName As String) As String
If FormulaCache Is Nothing Then Set FormulaCache = CreateObject("Scripting.Dictionary")
If FormulaCache.Exists(cacheName) Then
GetValidationFormula = FormulaCache(cacheName)
Else
GetValidationFormula = ""
End If
End Function

38
src/sh/tuk/module/Common_Selector.bas
View File

@@ -191,7 +191,7 @@ Public Sub BuildKenshuDropdown(ws As Worksheet, ByVal columnLetter As String, By
End With
End Sub
' Create Kenshu dropdown (exclude key = 0)
' Create Tokubetu dropdown
Public Sub BuildTokubetuDropdown(ws As Worksheet, ByVal columnLetter As String, ByVal rowNum As Long)
Dim tokubetuList As Object: Set tokubetuList = GetCache("tokubetuList")
Dim dropdownList As String: dropdownList = ""
@@ -213,3 +213,39 @@ Public Sub BuildTokubetuDropdown(ws As Worksheet, ByVal columnLetter As String,
.InputMessage = ""
End With
End Sub
' Create Renraku dropdown
Public Sub BuildRenrakuDropdown(ws As Worksheet, ByVal columnLetter As String, ByVal rowNum As Long)
Dim renrakuList As Object: Set renrakuList = GetCache("renrakuList")
Dim dropdownList As String: dropdownList = ""
Dim key As Variant
For Each key In renrakuList.Keys
If dropdownList = "" Then
dropdownList = key
Else
dropdownList = dropdownList & "," & key
End If
Next key
With ws.Range(columnLetter & rowNum).Validation
.Delete
.Add Type:=xlValidateList, Formula1:=dropdownList
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.InputMessage = ""
End With
End Sub
' Build dropdown using Caches sheet
Public Sub BuildDropdownFromCacheNamedRange(ws As Worksheet, columnLetter As String, rowNum As Long, cacheName As String)
Dim formula As String: formula = GetValidationFormula(cacheName)
If formula = "" Then Exit Sub
With ws.Range(columnLetter & rowNum).Validation
.Delete
.Add Type:=xlValidateList, Formula1:=formula
.IgnoreBlank = True
.InCellDropdown = True
End With
End Sub

64
src/sh/tuk/sheet/M1.cls
View File

@@ -20,6 +20,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
Call ClearDataRow(Me, START_COL + 1, END_COL, cell.Row, ERROR_COL)
Else
Call BuildTokubetuDropdown(Me, "L", cell.Row)
Call BuildRenrakuDropdown(Me, "K", cell.Row)
End If
Next
End If
@@ -126,14 +127,6 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Exit Sub
End If
' Check if M2 uses this M1 kukan code
Dim m2Cache As Object: Set m2Cache = GetCache("M2")
If Not m2Cache.Exists(cValue) Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("W001", cValue)
ws.Range("C" & rowNum).Interior.Color = RGB(255, 128, 0)
Exit Sub
End If
' Validation passed - clear error
ws.Cells(rowNum, errorCol).ClearContents
End Sub
@@ -158,3 +151,58 @@ Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow A
Finally:
Application.EnableEvents = True
End Sub
Private Sub ValidateWarn(ws As Worksheet, ByVal lastDataRow As Long)
On Error GoTo ErrorHandler
Dim exitMsg As String
' Get M2 sheet kukan code list directly
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim m2SheetConf As Object: Set m2SheetConf = sheetConfDict("M2")
Dim m2StartRow As Long: m2StartRow = m2SheetConf("StartRow")
Dim wsM2 As Worksheet: Set wsM2 = ThisWorkbook.Worksheets("M2")
Dim lastRowM2 As Long: lastRowM2 = GetLastDataRowInRange(wsM2)
If lastRowM2 < m2StartRow Then
exitMsg = "M2 sheet has no data"
GoTo ErrorHandler
End If
' Build kukan code list from M2 sheet
Dim kukanList As Object: Set kukanList = CreateObject("Scripting.Dictionary")
Dim r As Long
For r = m2StartRow To lastRowM2
Dim kukanCode As String: kukanCode = Trim(wsM2.Cells(r, 3).Value)
If kukanCode <> "" And Not kukanList.Exists(kukanCode) Then
kukanList.Add kukanCode, True
End If
Next r
Dim sheetConf As Object: Set sheetConf = sheetConfDict("M1")
Dim startRow As Long: startRow = sheetConf("StartRow")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
' Check all rows in M1 sheet
If lastDataRow < startRow Then
exitMsg = "M1 sheet has no data"
GoTo ErrorHandler
End If
Dim rowNum As Long
For rowNum = startRow To lastDataRow
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
If Not kukanList.Exists(cValue) Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("W001", cValue)
ws.Range("C" & rowNum).Interior.Color = RGB(255, 128, 0)
End If
NextRow:
Next rowNum
Exit Sub
ErrorHandler:
If exitMsg <> "" Then
MsgBox "ValidateWarn: " & exitMsg, vbExclamation
Else
MsgBox "ValidateWarn: " & Err.Description, vbExclamation
End If
End Sub

20
src/sh/tuk/sheet/M2.cls
View File

@@ -175,25 +175,7 @@ Private Sub CreateJDropdown(ByVal rowNum As Long)
If cache Is Nothing Then Exit Sub
' Build dropdown list from cache
Dim dropdownList As String: dropdownList = ""
Dim key As Variant
For Each key In cache.Keys
Dim displayText As String: displayText = MakeSelect(key, cache(key)(0))
If dropdownList = "" Then
dropdownList = displayText
Else
dropdownList = dropdownList & "," & displayText
End If
Next key
If dropdownList <> "" Then
With targetCell.Validation
.Add Type:=xlValidateList, Formula1:=dropdownList
.IgnoreBlank = True
.InCellDropdown = True
End With
End If
Call BuildDropdownFromCacheNamedRange(Me, "J", rowNum, "T" & iValue)
End Sub
Private Sub FillFromM1(ByVal ws As Worksheet, ByVal rowNum As Long)

4
src/sh/tuk/sheet/O1.cls
View File

@@ -11,5 +11,7 @@
Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
End Sub
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
End Sub

3
src/sh/tuk/sheet/O2.cls
View File

@@ -13,3 +13,6 @@ Private Sub Worksheet_Change(ByVal Target As Range)
If HasHeaderEdit = True Then Exit Sub
End Sub
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
End Sub

BIN
通勤手当テンプレート20260515.xlsm
View File

Binary file not shown.