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

banjinjiu · 发表于 2014-6-3 13:05

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

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

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

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

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

部分属性见附件：

mineshine · 发表于 2014-6-3 13:45

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

banjinjiu · 发表于 2014-6-3 14:14

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

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

banjinjiu · 发表于 2014-6-3 23:40

得到部分属性

Sub a()
For Each sht In ActiveWorkbook.Sheets
For Each obj In sht.OLEObjects
If obj.Name Like "ShockwaveFlash*" Then
Cells(i + 1, 1) = obj.Object.Movie
i = i + 1
End If
Next
Next sht
End Sub

复制代码

值

banjinjiu · 发表于 2014-6-3 23:42

窗体的，学习别人的

Sub EnumUserForms5()
On Error Resume Next
Dim i As Long, j As Long, n As Long
Cells(1, 1) = "控件"
Cells(1, 2) = "属性，方法，事件"
Cells(1, 3) = "值"
With ThisWorkbook.VBProject.VBComponents
For i = 1 To .Count
If .Item(i).Type = 3 Then
For j = 1 To ThisWorkbook.VBProject.VBComponents(i).Properties.Count
n = n + 1
Cells(n + 1, 1) = ThisWorkbook.VBProject.VBComponents(i).Name
Cells(n + 1, 2) = ThisWorkbook.VBProject.VBComponents(i).Properties(j).Name
Cells(n + 1, 3) = ThisWorkbook.VBProject.VBComponents(i).Properties(j)
Next j
End If
Next
End With
End Sub
'2007和2010用户需要进入“信任中心”→“宏设置”，勾选“信任对VBA工程对象模型的访问”
'2003用户进入“工具”→“宏”→“安全性”→“可靠发行商”，勾选“信任对“Visual Basic
'项目”的访问”
Sub 获取窗体的属性列表() '代码通用于Excel 2003、2007和2010
On Error Resume Next
Dim i As Long, j As Long, 数量 As Long, arr() As String
With ThisWorkbook.VBProject.VBComponents
For i = 1 To .Count '遍历工程中所有部件
If .Item(i).Type = 3 Then '如果其类型是窗体（值为1表示模块，2表示类模块）
'遍历窗体的所有属性
For j = 1 To ThisWorkbook.VBProject.VBComponents(i).Properties.Count
数量 = 数量 + 1 '累加计数器，该变量代表窗体属性的个数
ReDim Preserve arr(1 To 3, 1 To 数量) '重新声明数组的维数
With ThisWorkbook.VBProject.VBComponents(i)
arr(1, 数量) = .Name '对数组第一行赋值为窗体名
arr(2, 数量) = .Properties(j).Name '对数组第一行赋值为属性名
arr(3, 数量) = .Properties(j) '对数组第一行赋值为属性值
End With
Next j
End If
Next
End With
If 数量 > 0 Then '如果找到目标值
[a1:c1] = Array("控件", "属性", "值") '写入标题
[a2].Resize(数量, 3) = WorksheetFunction.Transpose(arr)
'将数组的值导入工作表
Columns("a:c").AutoFit 'AC列自动适应列宽
Columns("a:c").HorizontalAlignment = xlLeft '左对齐
End If
End Sub

复制代码

banjinjiu · 发表于 2014-6-4 22:20

'引用TypeLib Information
Sub listcontrols()
Cells(1, 1) = "控件"
Cells(1, 2) = "属性，方法，事件"
Cells(1, 3) = "值"
[a1:c1].Interior.ColorIndex = 3
On Error Resume Next
Dim ctl As Object, n As Long
n = 1
For Each ctl In Sheet1.OLEObjects
Dim iInf As InterfaceInfo
Set iInf = InterfaceInfoFromObject(ctl)
If Not (iInf Is Nothing) Then
Dim mem As MemberInfo
For Each mem In iInf.Members
If mem.InvokeKind And INVOKE_PROPERTYGET Then
n = n + 1
Cells(n, 1) = ctl.Name
Cells(n, 2) = mem.Name
Cells(n, 3) = CallByName(ctl, mem.Name, VbGet)
End If
Next
End If
Next
[a1:c65536].Columns.AutoFit
End Sub

复制代码

又学到一种方法。

02761752696 · 发表于 2017-8-31 14:22

谢谢分享

		自动登录	找回密码
密码			免费注册

[求助] Vba遍历控件，获取控件属性值