AW: Steuerelement Eigenschaft setzen
03.04.2015 21:20:43
Nepumuk
Hallo Ewald,
ich hole mir die Eigenschaften so:
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Private lngZeile As Long
Sub ShowTypeLibInfo()
' Mit Early Binding Verweis auf Typelib Information, vstlbinf.dll
' hier in: C:\Programme\Gemeinsame Dateien\Microsoft Shared\VSA\7.1\VsaEnv
' Dim tli As TLIApplication, ti As TypeLibInfo
Dim tli As Object, ti As Object
Dim i As Long
lngZeile = 2
Set tli = CreateObject("TLI.TLIApplication")
Set ti = tli.TypeLibInfoFromFile(ThisWorkbook.VBProject.References("MSFORMS").FullPath)
For i = 1 To ti.CoClasses.Count
myPrint 100, "CoClasses:", i, ti.CoClasses(i).Name
Show_CoClassInfo 100, ti.CoClasses(i)
Next
For i = 1 To ti.Constants.Count
myPrint 200, "Constants:", i, ti.Constants(i).Name
Show_Constants 200, ti.Constants(i)
Next
For i = 1 To ti.CustomDataCollection.Count
myPrint 300, "CustomDataCollection:", i, ti.CustomDataCollection(i).GUID, _
ti.CustomDataCollection(i).Value
Next
For i = 1 To ti.Declarations.Count
myPrint 400, "Declarations:", i, ti.Declarations(i).Name
Next
For i = 1 To ti.Interfaces.Count
myPrint 500, "Interfaces:", i, ti.Interfaces(i).Name
Show_Interfaces 500, ti.Interfaces(i)
Next
For i = 1 To ti.IntrinsicAliases.Count
myPrint 600, "IntrinsicAliases:", i, ti.IntrinsicAliases(i).Name
Next
For i = 1 To ti.Records.Count
myPrint 700, "Records:", i, ti.Records(i).Name
Next
For i = 1 To ti.TypeInfos.Count
myPrint 800, "TypeInfos:", i, ti.TypeInfos(i).Name
Show_TypeInfos 800, ti.TypeInfos(i)
Next
For i = 1 To ti.Unions.Count
myPrint 900, "Unions:", i, ti.Unions(i).Name
Next
Set ti = Nothing
Set tli = Nothing
End Sub
Public Sub Show_Constants(Offset As Integer, ci As Object) ' ci As ConstantInfo
Dim j As Long
For j = 1 To ci.Members.Count
myPrint Offset + 2, "Constants", j, ci.Members(j).Name, ci.Members(j).Value
Next
End Sub
Public Sub Show_CoClassInfo(Offset As Integer, cci As Object) ' cci as CoClassInfo
Dim j As Long
For j = 1 To cci.CustomDataCollection.Count
myPrint Offset + 1, "CustomDataCollection", j, cci.CustomDataCollection(j).GUID, _
cci.CustomDataCollection(j).Value
Next
If Not cci.DefaultEventInterface Is Nothing Then
myPrint Offset + 2, "DefaultEventInterface", 0, cci.DefaultEventInterface.Name
End If
For j = 1 To cci.Interfaces.Count
myPrint Offset + 3, "Interfaces", j, cci.Interfaces(j).Name
Show_Interfaces Offset, cci.Interfaces(j)
Next
End Sub
Public Sub Show_Interfaces(Offset As Integer, ifo As Object) ' ifo as InterfaceInfo
Dim j As Long
For j = 1 To ifo.CustomDataCollection.Count
myPrint Offset + 1, "CustomDataCollection", j, ifo.CustomDataCollection(j).GUID, _
ifo.CustomDataCollection(j).Value
Next
For j = 1 To ifo.ImpliedInterfaces.Count
myPrint Offset + 2, "ImpliedInterfaces", j, ifo.ImpliedInterfaces(j).Name
Next
For j = 1 To ifo.Members.Count
myPrint Offset + 3, "Members", j, ifo.Members(j).Name, _
getInvokeString(ifo.Members(j).InvokeKind)
Next
End Sub
Public Function getInvokeString(ByVal invoke As Long)
Dim s As String
Select Case invoke
Case 0: s = "INVOKE_UNKNOWN"
Case 1: s = "INVOKE_FUNC"
Case 2: s = "INVOKE_PROPERTYGET"
Case 4: s = "INVOKE_PROPERTYPUT"
Case 8: s = "INVOKE_PROPERTYPUTREF"
Case 16: s = "INVOKE_EVENTFUNC"
Case 32: s = "INVOKE_CONST"
Case Else: s = "? PANIC"
End Select
getInvokeString = s
End Function
Public Sub Show_TypeInfos(Offset As Integer, obj As Object)
Select Case TypeName(obj)
Case "InterfaceInfo"
Show_Interfaces Offset, obj
Case "CoClassInfo":
Show_CoClassInfo Offset, obj
Case "ConstantInfo":
Show_Constants Offset, obj
Case "IntrinsicAliasInfo"
myPrint Offset + 9, "IntrinsicAliasInfo", 0, obj.Name
Case Else:
myPrint Offset + 99, "?", 0, obj.Name, TypeName(obj)
End Select
End Sub
Private Sub myPrint(Offset As Long, strName As String, _
iCount As Long, var1 As Variant, Optional var2 As Variant)
Cells(lngZeile, 1).Value = Offset
Cells(lngZeile, 2).Value = strName
Cells(lngZeile, 3).Value = iCount
Cells(lngZeile, 4).Value = var1
Cells(lngZeile, 5).Value = var2
lngZeile = lngZeile + 1
End Sub
wenn es eine PUT-Property gibt (INVOKE_PROPERTYPUT), dann ist sie per Designer änderbar.
Gruß
Nepumuk