我现在道歉,因为我是一个绝对的初学者(也是我的图片和代码天堂已被推广)。
我在Excel中有一个下拉列表框,由我在excel内部选择的范围填充(即在放置后右键单击ActiveX控件并更改属性)。我希望如果选择列表中的某些项目,则会从列表中删除其他项目,以便无法选择它们。例如。有一个列表A,B和C,但是当用户选择A时,B将从列表中消失。
我的代码如下。第一部分编码下拉列表
Sub Rectangle1_Click()
Dim SelShp As Shape, ListShp As Shape, SelList As Variant, i As Integer
Set SelShp = Sheet8.Shapes(Application.Caller)
Set ListBx = Sheet8.ListBox1
If SelShp.TextFrame2.TextRange.Characters.Text = "Select Buffers" Then
ListBx.Visible = True
SelShp.TextFrame2.TextRange.Characters.Text = "Set Buffers"
Else
ListBx.Visible = False
SelShp.TextFrame2.TextRange.Characters.Text = "Select Buffers"
For i = 0 To Sheet8.ListBox1.ListCount - 1
If Sheet8.ListBox1.Selected(i) = True Then
SelList = SelList & "; " & Sheet8.ListBox1.List(i)
End If
Next i
If SelList <> "" Then
Range("ListBox1Output") = Right(SelList, Len(SelList) - 1)
Else
Range("ListBox1Output") = ""
End If
End If
End Sub
第二个代码是应该从列表中删除项目
Private Sub ListBox1_Change()
If Sheet8.ListBox1.Selected(0) Then
Sheet8.ListBox1.RemoveItem 1
End If
End Sub
问题是,当我尝试时,我得到一个运行时错误&#39; -2147467259(80004005)&#39;:未指定的错误。,如果我尝试调试它突出显示&#39; Sheet8.ListBox1.RemoveItem 1&#39;,但我不知道我知道自己做错了什么。任何帮助都会非常感激,如果我错过了一些非常简单的事情,我很抱歉。
编辑:自从我发布以来,我一直在研究这个问题,并找到了一些解决方案,但遇到了其他障碍。
我的第一个问题是.RemoveItem方法没有做任何事情。事实证明,如果使用.ListFillRange方法填充ListBox,.RemoveItem将无法工作 - 如果我以后想要.RemoveItem,则必须使用.AddItem填充ListBox。
在我解决这个问题之后,我决定尝试用更简单的数据做我想做的事情:
我有2个列表框,我用数据填充其中一个。在ListBox1中选择一个项目后,该项目将被复制到ListBox2中,并从ListBox1中删除。此外,如果选择了ListBox1中的某些项目,则会从列表框中删除其他项目,以便无法选择它们。例如。有一个列表A,B和C,但是当用户选择A时,B将从列表中消失。
我的代码已经达到某些情况下的效果。不幸的是,项目的顺序很重要,并且出于某种原因,对于某些项目序列,代码不能按预期工作 - 例如我的通用项目恰好是:德国,印度,法国,美国,英国。选择&#39;德国&#39;,此项目出现在ListBox2中,它将从ListBox1中删除,而且,&#39; France&#39;从ListBox1中删除。这项工作正常,直到项目按字母顺序排列,此时选择&#39;德国&#39;,此项目出现在ListBox2中,它将从ListBox1中删除,&#39; France&#39;从ListBox1中删除,并将印度和美国移入ListBox2 ......好像曾经的法国&#39;已被删除,选择它下面的任何内容并由于某种原因运行ListBox1_Change()子的前2个循环。使用消息框中断它是有原因的,但我无法在不使用消息框的情况下解决它...
我的代码如下,对我尝试包含的内容有一些评论。
使用随机位置的项目填充ListBox1
Sub Populate_ListBox1()
'Clear LB1 before populating it
Sheet1.ListBox1.Clear
Sheet1.ListBox2.Clear
Sheet1.ListBox1.AddItem "Germany"
Sheet1.ListBox1.AddItem "India"
Sheet1.ListBox1.AddItem "France"
Sheet1.ListBox1.AddItem "USA"
Sheet1.ListBox1.AddItem "England"
End Sub
尝试在更改ListBox1中的项目时移动选定的ListBox1项目
Private Sub ListBox1_Change()
'Variable Declaration
Dim iCnt As Integer
Dim jCnt As Integer
Dim kCnt As Integer
'Move Selected Item from Listbox1 to Listbox2
For iCnt = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(iCnt) = True Then
Me.ListBox2.AddItem Me.ListBox1.List(iCnt)
End If
Next
'Clear Selected Item from Listbox1
For iCnt = Me.ListBox1.ListCount - 1 To 0 Step -1
If Me.ListBox1.Selected(iCnt) = True Then
Me.ListBox1.RemoveItem iCnt
'Me.ListBox1.Selected(iCnt) = False 'Nope
'Exit For
End If
Next
'If Germany is in Listbox2, then remove France from LB1
For kCnt = 0 To Me.ListBox2.ListCount - 1
If Me.ListBox2.Column(0, kCnt) = "Germany" Then
For jCnt = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Column(0, jCnt) = "France" Then
Me.ListBox1.RemoveItem jCnt
'Me.ListBox1.Locked = True 'Nope
'Me.ListBox1.Enabled = False 'Nope
'Me.ListBox1.ListIndex = -1 'This crashes excel...
'MsgBox "blah" 'For some reason this works >.<
Exit Sub
End If
Next jCnt
End If
Next
End Sub
我非常感谢这方面的帮助,甚至会建议使用与excel一起使用的其他程序(尝试根据索引更改列表框中的项目,更改,而不是他们的价值观是一场噩梦)