表sheet中添加listbox的完整资料

740688321

https://www.contextures.com/excelvbalistboxcreate.html
eh中没有搜到表sheet中添加listbox的完整资料，这是度娘帮忙搜到的，分享给大家。
黄底是我的注释哈

zpy2

谢谢分享。。

740688321

放在这里自我欣赏，不喜勿喷

1. Sub 动态增加ListBox1()
   
2.     Set x = ActiveSheet.OLEObjects.Add(ClassType:="Forms.ListBox.1", Link:=False, _
   
3.         DisplayAsIcon:=False, Left:=435.6, Top:=30, Width:=115.8, Height:=135)
   
4.     With x '各句是有顺序的，不能乱
   
5.         .Object.ListStyle = 1
   
6.         '.Object.MultiSelect = 1
   
7.         '.ListFillRange = "$A$1:$A$5" ''正确写法
   
8.         For Each Cel In Sheets("Lists").Range("A1:A4").Cells
   
9.             .Object.AddItem Cel.Value2
   
10.         Next Cel
    
11.         .LinkedCell = "I1" '如果MultiSelect=1就没用了,不能写在MultiSelect之后,
    
12.         .Activate '有这一句，才起作用
    
13.     End With
    
14. End Sub
    
15. 
    
16. Sub 动态增加ListBox2()
    
17.     Dim i, arr
    
18.     arr = Array("A1", "A2", "A3")
    
19.     Set x = ActiveSheet.OLEObjects.Add(ClassType:="Forms.ListBox.1", Link:=False, _
    
20.         DisplayAsIcon:=False, Left:=435.6, Top:=T, Width:=90, Height:=135)
    
21.     With x '各句是有顺序的，不能乱
    
22.         .Object.ListStyle = 1
    
23.         '.Object.MultiSelect = 1
    
24.         '.ListFillRange = "$A$1:$A$5" ''正确写法
    
25.         For i = LBound(arr) To UBound(arr)
    
26.             .Object.AddItem arr(i)
    
27.         Next
    
28.         .LinkedCell = Range("I1").Address '如果MultiSelect=1就没用了,不能写在MultiSelect之后,
    
29.         .Activate '有这一句，才起作用
    
30.     End With
    
31. End Sub

复制代码

740688321

接上
应用:

1. ''《模块1》的"动态增加ListBox2" 产生ListBox1之后
   
2. Private Sub ListBox1_Change()
   
3.     If Len(ActiveCell) = 0 Then
   
4.         ActiveCell = ListBox1.Text
   
5.     Else
   
6.         ActiveCell = ActiveCell & "," & ListBox1.Text
   
7.     End If
   
8. End Sub
   
9. Private Sub Worksheet_SelectionChange(ByVal Target As Range)  '鼠标选定触发
   
10.     If Target.Column = 1 Then
    
11.         ListBox1.Visible = True
    
12.         ListBox1.Left = ActiveCell(1, 2).Left  '活动单元横坐标
    
13.         ListBox1.Top = ActiveCell(1, 2).Top + 17 '活动单元纵坐标
    
14.         ''动态取值
    
15.         ListBox1.List = Application.Transpose(Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row))
    
16.         Target = ""
    
17.     Else
    
18.         ListBox1.Visible = False
    
19.     End If
    
20. End Sub
    

复制代码

到此，Listbox可进入实用。

y1983y

740688321 发表于 2019-5-26 15:09
接上
应用:

您好！帮我看看这个如何破解，谢谢！
http://club.excelhome.net/thread-1502775-1-1.html

巴拿巴

请问，vba写代码时，没有listbox，只有worksheet 和通用？该怎么添加啊，谢谢了