Поле со Списком (ComboBox) - Зависимые (связанные) списки «Страна», «Регион» и «Город» (+ Пример)По материалам: https://www.cyberforum.ru/ms-access/thread3016093.html#post16423534 Поля со списком: «Страна», «Регион» и «Город» на «каскадно-свободной подвеске» 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) Пример |
|||
L.E. 29.08.2022 |