从属多选弹出列表框(VBA)

时间:2019-05-06 22:42:08

标签: excel vba multichoiceitems

我有一个xlsm文件,在其中的一列(27)“房间”中,我应用了VBA代码,当您单击其中一个单元格时,该代码会弹出多选列表。用户可以从该框中选择一个,两个或所有房间。我遇到的问题是,我停留在一行代码中,试图找出如何进行修改。现在,弹出框显示范围K60:K87中的值。但是我需要基于该单元格验证值的框中的房间列表。房间单元取决于Building&RoomType&VCSession,因此它根据命名范围给出不同的值。

我尝试过 Cells.SpecialCells(xlCellTypeAllValidation)`

但它没有应聘工作。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.EnableEvents = False

On Error GoTo exitHandler

If Target.Column = 27 Then
  gCountryListArr = Sheets("site_reference_used").Range("K60:K87").Value
  gCellCurrVal = Target.Value
  UserForm1.Show 'Pop up the form
  Target.Value = gCellCurrVal
End If

exitHandler:
  Application.EnableEvents = True
End Sub

/ ..................................... UserForm1: ................................ /

Private Sub CommandButton1_Click()
UserForm1.Hide 'Pop up the form
End Sub
Private Sub CommandButton2_Click()
  For ii = 0 To ListBox1.ListCount - 1
   Me.ListBox1.Selected(ii) = False
Next ii
End Sub
Private Sub CommandButton3_Click()
   For ii = 0 To ListBox1.ListCount - 1
    Me.ListBox1.Selected(ii) = True
Next ii
End Sub
Private Sub CommandButton4_Click()
  gCellCurrVal = ""
  For ii = 0 To ListBox1.ListCount - 1
   If Me.ListBox1.Selected(ii) = True Then
    If gCellCurrVal = "" Then
      gCellCurrVal = Me.ListBox1.List(ii)
    Else
      gCellCurrVal = gCellCurrVal & "," & Me.ListBox1.List(ii)
    End If
   End If
  Next ii
  UserForm1.Hide
End Sub

Private Sub UserForm_Activate()
On Error Resume Next
'On each activation, clear the whole,
'then add every room list item as blank
Me.ListBox1.Clear
For Each element In gCountryListArr
  Me.ListBox1.AddItem element
Next element
UserForm_initialize
End Sub

Private Sub UserForm_initialize()
 For Each element In Split(gCellCurrVal, ",")
  For ii = 0 To ListBox1.ListCount - 1
   If element = Me.ListBox1.List(ii) Then
    Me.ListBox1.Selected(ii) = True
   End If
  Next ii
 Next element
End Sub

0 个答案:

没有答案