Attribute VB_Name = "Common_Selector" Option Explicit ' ============================================================ ' Module Name: Common_Selector ' Module Desc: Build dropdown lists from cache data ' Module Methods: ' - BuildTransportList ' - BuildTodokeList ' - BuildOufukuList ' - BuildKoutaiList ' - BuildKetteiList ' - BuildHigaitouList ' - BuildKanshokuList ' - BuildKenshuList ' ============================================================ ' ============================================================ ' Event Handlers ' ============================================================ ' Create Transport (T) dropdown from Z1 cache Public Function BuildTransportList() Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1) Dim dropdownList As String Dim key As Variant For Each key In z1Cache.Keys Dim displayText As String displayText = MakeSelect(key, z1Cache(key)(0)) If dropdownList = "" Then dropdownList = displayText Else dropdownList = dropdownList & "," & displayText End If Next key BuildTransportList = dropdownList End Function ' Create Todoke (G) dropdown Public Function BuildTodokeList() Dim o3Cache As Object: Set o3Cache = GetCache(CACHE_O3) Dim dropdownList As String Dim key As Variant For Each key In o3Cache.Keys Dim displayText As String displayText = MakeSelect(key, o3Cache(key)(0)) If dropdownList = "" Then dropdownList = displayText Else dropdownList = dropdownList & "," & displayText End If Next key BuildTodokeList = dropdownList End Function ' Create Oufuku (M) dropdown Public Function BuildOufukuList() Dim oufukuList As Object: Set oufukuList = GetCache("oufukuList") Dim dropdownList As String Dim key As Variant For Each key In oufukuList.Keys Dim displayText As String displayText = MakeSelect(key, oufukuList(key)(0)) If dropdownList = "" Then dropdownList = displayText Else dropdownList = dropdownList & "," & displayText End If Next key BuildOufukuList = dropdownList End Function ' Create Koutai (N) dropdown Public Function BuildKoutaiList() Dim koutaiList As Object: Set koutaiList = GetCache("koutaiList") Dim dropdownList As String Dim key As Variant For Each key In koutaiList.Keys Dim displayText As String displayText = MakeSelect(key, koutaiList(key)(0)) If dropdownList = "" Then dropdownList = displayText Else dropdownList = dropdownList & "," & displayText End If Next key BuildKoutaiList = dropdownList End Function ' Create Kettei (AU) dropdown Public Function BuildKetteiList() Dim z2Cache As Object: Set z2Cache = GetCache(CACHE_Z2) Dim dropdownList As String Dim key As Variant For Each key In z2Cache.Keys Dim displayText As String displayText = MakeSelect(key, z2Cache(key)(0)) If dropdownList = "" Then dropdownList = displayText Else dropdownList = dropdownList & "," & displayText End If Next key BuildKetteiList = dropdownList End Function ' Create Higaitou (AW) dropdown Public Function BuildHigaitouList() Dim higaitouList As Object: Set higaitouList = GetCache("higaitouList") Dim dropdownList As String Dim key As Variant For Each key In higaitouList.Keys Dim displayText As String displayText = MakeSelect(key, higaitouList(key)(0)) If dropdownList = "" Then dropdownList = displayText Else dropdownList = dropdownList & "," & displayText End If Next key BuildHigaitouList = dropdownList End Function ' Create Kanshoku (BC) dropdown Public Function BuildKanshokuList() Dim o2Cache As Object: Set o2Cache = GetCache(CACHE_O2) Dim dropdownList As String Dim key As Variant For Each key In o2Cache.Keys Dim displayText As String displayText = MakeSelect(key, o2Cache(key)(0)) If dropdownList = "" Then dropdownList = displayText Else dropdownList = dropdownList & "," & displayText End If Next key BuildKanshokuList = dropdownList End Function ' Create Kenshu dropdown (exclude key = 0) Public Sub BuildKenshuDropdown(ws As Worksheet, ByVal columnLetter As String, ByVal rowNum As Long) Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList") Dim dropdownList As String Dim key As Variant For Each key In kenshuList.Keys If key <> 0 Then Dim displayText As String displayText = MakeSelect(key, kenshuList(key)(0)) If dropdownList = "" Then dropdownList = displayText Else dropdownList = dropdownList & "," & displayText End If 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 ' 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 = "" Dim key As Variant For Each key In tokubetuList.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 ' 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 ' ============================================================ ' Z4 Rosen Dropdown Builders for M1 E/F/H cascade ' ============================================================ ' Build F column (station from) dropdown based on E column (rosen name) Public Sub BuildZ4StationFromDropdown(ws As Worksheet, ByVal columnLetter As String, ByVal rowNum As Long, ByVal rosen As String) Dim z4RosenCache As Object: Set z4RosenCache = GetCache(CACHE_Z4ROSEN) ws.Range(columnLetter & rowNum).Validation.Delete If rosen = "" Then Exit Sub If Not z4RosenCache.Exists(rosen) Then Exit Sub Dim stationFromDict As Object: Set stationFromDict = z4RosenCache(rosen) Dim dropdownList As String: dropdownList = "" Dim stationFrom As Variant For Each stationFrom In stationFromDict.Keys If dropdownList = "" Then dropdownList = stationFrom Else dropdownList = dropdownList & "," & stationFrom End If Next stationFrom If dropdownList = "" Then Exit Sub With ws.Range(columnLetter & rowNum).Validation .Delete .Add Type:=xlValidateList, Formula1:=dropdownList .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .InputMessage = "" End With End Sub ' Build H column (station to) dropdown based on E column (rosen name) and F column (station from) Public Sub BuildZ4StationToDropdown(ws As Worksheet, ByVal columnLetter As String, ByVal rowNum As Long, ByVal rosen As String, ByVal stationFrom As String) Dim z4RosenCache As Object: Set z4RosenCache = GetCache(CACHE_Z4ROSEN) ws.Range(columnLetter & rowNum).Validation.Delete If rosen = "" Or stationFrom = "" Then Exit Sub If Not z4RosenCache.Exists(rosen) Then Exit Sub Dim stationFromDict As Object: Set stationFromDict = z4RosenCache(rosen) If Not stationFromDict.Exists(stationFrom) Then Exit Sub Dim stationToDict As Object: Set stationToDict = stationFromDict(stationFrom) Dim dropdownList As String: dropdownList = "" Dim stationTo As Variant For Each stationTo In stationToDict.Keys If dropdownList = "" Then dropdownList = stationTo Else dropdownList = dropdownList & "," & stationTo End If Next stationTo If dropdownList = "" Then Exit Sub With ws.Range(columnLetter & rowNum).Validation .Delete .Add Type:=xlValidateList, Formula1:=dropdownList .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .InputMessage = "" End With End Sub ' Create display dropdown Public Sub BuildDisplayDropdown(ws As Worksheet, ByVal rowNum As Long) ' validate sheet Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() If Not sheetConfDict.Exists(ws.CodeName) Then Err.Raise ERR_CONFIG_NOT_FOUND, "BuildDisplayDropdown", "Sheet not configured: " & ws.CodeName End If ' validate Display Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) If Not sheetConf.Exists("DisplayCol") Then Err.Raise ERR_CONFIG_NOT_FOUND, "BuildDisplayDropdown", "Display Column not configured: " & ws.CodeName End If Dim displayCol As String: displayCol = sheetConf("DisplayCol") Dim dropdownList As String: dropdownList = "0:OFF,1:ON" With ws.Range(displayCol & 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