vba/src/sh/tuk/module/Common_Selector.bas

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