Поле со Списком (ComboBox) - Зависимые (связанные) списки «Страна», «Регион» и «Город» (+ Пример)

По материалам: https://www.cyberforum.ru/ms-access/thread3016093.html#post16423534

Поля со списком: «Страна», «Регион» и «Город» на «каскадно-свободной подвеске»
Можно вводить последовательно:
   01.     Страна (отсев регионов и городов по стране)
   02.     Регион (отсев городов по региону (и стране))
   03.     Город
А можно, например, сразу указать «Город» (из всего списка городов) или только «Регион»
– а всё остальное «подтянется» автоматом.

Например:  Попробуйте указать регион "CA" (USA) ...

+ Если у страны нет регионов - поле блокируется («по просьбам трудящихся»).
+ Если в отфильтрованном списке осталось только одно значение - оно применяется автоматически

Private Sub cmdDelete_Click()
'Delete Button ...
'---------------------------------------------------------------------------------------------------
Dim sVal, vVal
On Error GoTo cmdDelete_Click_Err
    
    If Me.NewRecord = True Then
        Me.Undo
    Else
        sVal = "CustomerSID = " & Me.CustomerID
        vVal = DCount("*", "Orders", sVal)
        If vVal > 0 Then
            MsgBox "The record cannot be deleted because " & _
                "table 'Orders' includes related records.", vbExclamation
            GoTo cmdDelete_Click_End
       End If
       Me.Recordset.Delete
       Me.Refresh
    End If
 
cmdDelete_Click_End:
    Exit Sub

cmdDelete_Click_Err:
    sVal = "Error " & Err.Number & " (" & Err.Description & ") in Sub : " & _
           "cmdDelete_Click - Form_Customers."
    MsgBox sVal, vbCritical, "Error!"
    'Debug.Print sVal':  Debug.Print "cmdDelete_Click_Line: " & Erl & "."
    Err.Clear
    Resume cmdDelete_Click_End
End Sub

Private Sub cmdAdd_Click()
    DoCmd.GoToRecord acDataForm, Me.Name, acNewRec
End Sub

Private Sub Form_Current()
    PlaceRowSourceUpdate 1 'see to procedure below
End Sub

Private Sub cmdUndo_Click()
    Me.Undo
    Me.cmdExit.SetFocus
    Me.cmdUndo.Enabled = False
    Me.cmdSave.Enabled = False
    'Me.Refresh
    PlaceRowSourceUpdate 1 'see to procedure below
End Sub

Private Sub cmdSave_Click()
    Me.Dirty = False
    Me.cmdExit.SetFocus
    Me.cmdUndo.Enabled = False
    Me.cmdSave.Enabled = False
End Sub

Private Sub Form_Dirty(Cancel As Integer)
    Me.cmdUndo.Enabled = True
    Me.cmdSave.Enabled = True
End Sub

Private Sub cmdExit_Click()
    DoCmd.Close acForm, Me.Name
End Sub

Private Sub cbxCitySID_AfterUpdate()
Dim iLevel%
'Check the Level(s) Up first:
    If Me.cbxCitySID.ListIndex > -1 Then 'City Selected !
        'If Country is not from selected City!
        If Not Nz(Me.cbxCountrySID, 0) = Me.cbxCitySID.Column(3) Then
            Me.cbxCountrySID = Me.cbxCitySID.Column(3)
            iLevel = 1
        End If
        'If Region is not from selected City!
        If Not Nz(Me.cbxRegionSID, 0) = Me.cbxCitySID.Column(4) Then
            Me.cbxRegionSID = Me.cbxCitySID.Column(4)
            If iLevel = 0 Then iLevel = 2
        End If
    End If
    
    If Not iLevel = 0 Then
        PlaceRowSourceUpdate iLevel, True 'see to procedure below
        cbxCountrySID_AfterUpdate
    End If
End Sub

Private Sub cbxCountrySID_AfterUpdate()
    PlaceRowSourceUpdate 1, True
End Sub

Private Sub cbxRegionSID_AfterUpdate()
Dim iLevel%
    iLevel = 2
'Check the Level(s) Up first:
    If Me.cbxRegionSID.ListIndex > -1 Then 'Region Selected !
        'If Region is not from selected Country!
        If Not Nz(Me.cbxCountrySID, 0) = Me.cbxRegionSID.Column(3) Then
            Me.cbxCountrySID = Me.cbxRegionSID.Column(3)
            iLevel = 1
        End If
    End If
    PlaceRowSourceUpdate iLevel, True 'see to procedure below
End Sub

Private Sub PlaceRowSourceUpdate(iLevel%, Optional bAllowReplaceVal As Boolean)
Dim sVal$, sColumnWidths$, sListWidth$

'Region by Country:
    If iLevel < 2 Then
        sVal = ""
        If Me.cbxCountrySID.ListIndex > -1 Then 'Country Selected !
            sVal = sVal & " AND (rgnCountrySID = " & Me.cbxCountrySID & ")"
        End If
        If Len(sVal) > 6 Then
            sVal = "WHERE " & Mid(sVal, 6) & " "
            sColumnWidths = "0;2300;0;0"
            sListWidth = "5103"
        Else
            sColumnWidths = "0;2300;2300;0"
            sListWidth = "4600"
        End If
        sVal = "SELECT RegionID, rgnRegion, cryCountry, rgnCountrySID FROM Countries " & _
                    "INNER JOIN Regions ON Countries.CountryID = Regions.rgnCountrySID " & _
                    sVal & _
                    "ORDER BY cryCountry, rgnRegion;"
        Me.cbxRegionSID.RowSource = sVal
        Me.cbxRegionSID.ColumnWidths = sColumnWidths
        Me.cbxRegionSID.ListWidth = sListWidth
        If Me.cbxRegionSID.ListIndex = -1 And bAllowReplaceVal = True Then
            Me.cbxRegionSID = Null
            'If only value present in list
            If Me.cbxRegionSID.ListCount = 1 Then Me.cbxRegionSID = Me.cbxRegionSID.ItemData(0)
        End If
        'If there are no regions in selected country UnAble Region field
        Me.cbxRegionSID.Enabled = (Me.cbxRegionSID.ListCount > 0)
    End If

'City by Country and Region (if Region selected) :
    If iLevel < 3 Then
        sVal = ""
        If Me.cbxCountrySID.ListIndex > -1 Then 'Country Selected !
            sVal = sVal & " AND (ctyCountrySID = " & Me.cbxCountrySID & ")"
        End If
        
        If Me.cbxRegionSID.ListIndex > -1 Then 'Region Selected !
            sVal = sVal & " AND (ctyRegionSID = " & Me.cbxRegionSID & ")"
        End If

        If Len(sVal) > 6 Then
            sVal = " WHERE " & Mid(sVal, 6)
            sColumnWidths = "0;2835;0;0;0"
            sListWidth = "4000"
        Else
            sColumnWidths = "0;2835;2268;0;0"
            sListWidth = "5000"
        End If

        sVal = "SELECT CityID, ctyCityName, cryCountry, ctyCountrySID, ctyRegionSID FROM Countries " & _
                "INNER JOIN (Regions RIGHT JOIN Cities ON Regions.RegionID = Cities.ctyRegionSID) " & _
                "ON Countries.CountryID = Cities.ctyCountrySID " & _
                sVal & _
                "ORDER BY ctyCityName;"
        
        Me.cbxCitySID.ColumnWidths = sColumnWidths
        Me.cbxCitySID.ListWidth = sListWidth
        Me.cbxCitySID.RowSource = sVal
        
        If Me.cbxCitySID.ListIndex = -1 And bAllowReplaceVal = True Then
            Me.cbxCitySID = Null
            'If only value present in list
            If Me.cbxCitySID.ListCount = 1 Then Me.cbxCitySID = Me.cbxCitySID.ItemData(0)
        End If
    End If
End Sub

Private Sub Form_Undo(Cancel As Integer)
    If Not Me.ActiveControl.Name = "CmdUndo" Then
        Cancel = True
        MsgBox "Use [Undo] button to cancel edition.", vbExclamation, "Undo operation"
    End If
End Sub

MSA-2007 и выше ( 163 kB) Пример