Vba遍历控件，获取控件属性值

banjinjiu

Excel中，视图——工具栏——控件工具箱，选择“命令按钮”，或其他控件的——Shackwave Flash Object，在excel中能画出控件。

点击右键——属性，能看到这些控件的属性值。

假如这些控件种类、数量有很多，有命令按钮、复选框按钮、选项按钮、单选、ShockwaveFlash控件，可能还有不知道名字的。

我的要求，使用程序，如何遍历控件，遍历控件，遍历控件，获得这些控件的属性值？

请各位大侠帮忙，帮我做下，谢谢。

部分属性见附件：

mineshine

如何枚舉控件屬性？？？
http://club.excelhome.net/thread-197713-1-1.html

banjinjiu

mineshine 发表于 2014-6-3 13:45
如何枚舉控件屬性？？？
http://club.excelhome.net/thread-197713-1-1.html

大侠，你好，我仔细看了，这个是窗体的，Sheet1工作表的没有。

banjinjiu

得到部分属性

1. Sub a()
   
2. For Each sht In ActiveWorkbook.Sheets
   
3.     For Each obj In sht.OLEObjects
   
4.         If obj.Name Like "ShockwaveFlash*" Then
   
5.            Cells(i + 1, 1) = obj.Object.Movie
   
6.            i = i + 1
   
7.         End If
   
8.     Next
   
9. Next sht
   
10. End Sub

复制代码

值

banjinjiu

窗体的，学习别人的

1. Sub EnumUserForms5()
   
2.     On Error Resume Next
   
3.     Dim i As Long, j As Long, n As Long
   
4.     Cells(1, 1) = "控件"
   
5.     Cells(1, 2) = "属性，方法，事件"
   
6.     Cells(1, 3) = "值"
   
7.         With ThisWorkbook.VBProject.VBComponents
   
8.         For i = 1 To .Count
   
9.             If .Item(i).Type = 3 Then
   
10.                 For j = 1 To ThisWorkbook.VBProject.VBComponents(i).Properties.Count
    
11.                 n = n + 1
    
12.                     Cells(n + 1, 1) = ThisWorkbook.VBProject.VBComponents(i).Name
    
13.                     Cells(n + 1, 2) = ThisWorkbook.VBProject.VBComponents(i).Properties(j).Name
    
14.                     Cells(n + 1, 3) = ThisWorkbook.VBProject.VBComponents(i).Properties(j)
    
15.                 Next j
    
16.             End If
    
17.         Next
    
18.     End With
    
19. End Sub
    
20. 
    
21. '2007和2010用户需要进入“信任中心”→“宏设置”，勾选“信任对VBA工程对象模型的访问”
    
22. '2003用户进入“工具”→“宏”→“安全性”→“可靠发行商”，勾选“信任对“Visual Basic
    
23. '项目”的访问”
    
24. Sub 获取窗体的属性列表()  '代码通用于Excel 2003、2007和2010
    
25. On Error Resume Next
    
26. Dim i As Long, j As Long, 数量 As Long, arr() As String
    
27. With ThisWorkbook.VBProject.VBComponents
    
28.   For i = 1 To .Count     '遍历工程中所有部件
    
29.     If .Item(i).Type = 3 Then  '如果其类型是窗体（值为1表示模块，2表示类模块）
    
30.         '遍历窗体的所有属性
    
31.       For j = 1 To ThisWorkbook.VBProject.VBComponents(i).Properties.Count
    
32.         数量 = 数量 + 1 '累加计数器，该变量代表窗体属性的个数
    
33.         ReDim Preserve arr(1 To 3, 1 To 数量)  '重新声明数组的维数
    
34.         With ThisWorkbook.VBProject.VBComponents(i)
    
35.           arr(1, 数量) = .Name  '对数组第一行赋值为窗体名
    
36.           arr(2, 数量) = .Properties(j).Name  '对数组第一行赋值为属性名
    
37.           arr(3, 数量) = .Properties(j)    '对数组第一行赋值为属性值
    
38.         End With
    
39.       Next j
    
40.     End If
    
41.   Next
    
42. End With
    
43. If 数量 > 0 Then '如果找到目标值
    
44.   [a1:c1] = Array("控件", "属性", "值")    '写入标题
    
45.   [a2].Resize(数量, 3) = WorksheetFunction.Transpose(arr)
    
46.   '将数组的值导入工作表
    
47.   Columns("a:c").AutoFit  'AC列自动适应列宽
    
48.   Columns("a:c").HorizontalAlignment = xlLeft  '左对齐
    
49. End If
    
50. End Sub

复制代码

banjinjiu

1. '引用TypeLib Information
   
2. Sub listcontrols()
   
3.     Cells(1, 1) = "控件"
   
4.     Cells(1, 2) = "属性，方法，事件"
   
5.     Cells(1, 3) = "值"
   
6.     [a1:c1].Interior.ColorIndex = 3
   
7.     On Error Resume Next
   
8.     Dim ctl As Object, n As Long
   
9.         n = 1
   
10.         For Each ctl In Sheet1.OLEObjects
    
11.         Dim iInf As InterfaceInfo
    
12.         Set iInf = InterfaceInfoFromObject(ctl)
    
13.         If Not (iInf Is Nothing) Then
    
14.         Dim mem As MemberInfo
    
15.         For Each mem In iInf.Members
    
16.         If mem.InvokeKind And INVOKE_PROPERTYGET Then
    
17.             n = n + 1
    
18.             Cells(n, 1) = ctl.Name
    
19.             Cells(n, 2) = mem.Name
    
20.             Cells(n, 3) = CallByName(ctl, mem.Name, VbGet)
    
21.         End If
    
22.         Next
    
23.         End If
    
24.         Next
    
25.     [a1:c65536].Columns.AutoFit
    
26. End Sub

复制代码

又学到一种方法。

02761752696

谢谢        分享