AW: Bennenungen "auslesen"
03.09.2010 23:48:39
JogyB
Hallo Gegga,
hier auch noch ein entsprechender Code von mir:
' Liest alle Controls aus den Formularen aus
Sub controlAusgabe()
Dim myCtl As Control
Dim ausWbk As Workbook
Dim myForms() As Object
Dim formCount As Long
Dim k As Long
Dim codeObject As Object
Dim myForm As Object
On Error GoTo errorHandler
Application.ScreenUpdating = False
' Verhindert Initialisierung der UserForms
formCheck = True
ReDim myForms(0 To 0)
For Each codeObject In ThisWorkbook.VBProject.VBComponents
With codeObject
' Alle Forms (Code 3) auslesen
If .Type = 3 Then
If UBound(myForms) = 0 Then
ReDim myForms(1 To 1)
Else
ReDim Preserve myForms(1 To UBound(myForms) + 1)
End If
Set myForms(UBound(myForms)) = codeObject
End If
End With
Next
'neues Workbook erstellen
Set ausWbk = Workbooks.Add
With ausWbk
' Daten eintragen
For formCount = 1 To UBound(myForms)
' Blätter erstellen
Call .Worksheets.Add(, .Worksheets(.Worksheets.Count))
.Worksheets(.Worksheets.Count).Name = myForms(formCount).Name
' Muss so gemacht werden, da myforms ein codeobject ist, bei
' dem sich die UserForm-Eigenschaften nicht abfragen lassen
Set myForm = VBA.UserForms.Add(myForms(formCount).Name)
With .Worksheets(myForms(formCount).Name)
' Überschriften
.Cells(1, 1).Value = myForm.Caption
.Cells(3, 2).Value = "Control"
.Cells(3, 1).Value = "Typ"
.Cells(3, 3).Value = "Caption"
.Cells(3, 4).Value = "Text"
.Cells(3, 5).Value = "ToolTip"
k = 1
' Werte
For Each myCtl In myForm.Controls
On Error Resume Next
.Cells(3 + k, 1).Value = TypeName(myCtl)
.Cells(3 + k, 2).Value = myCtl.Name
.Cells(3 + k, 3).Value = myCtl.Caption
.Cells(3 + k, 4).Value = myCtl.Text
.Cells(3 + k, 5).Value = myCtl.ControlTipText
k = k + 1
On Error GoTo errorHandler
Next
' Sortieren - letzte Zeile wird in Spalte 2 gesucht, da ein Name
' sicher vorhanden ist. Wenn weitere Spalten (aktuell 5) hinzukommen,
' dann muss der Offset angepaßt werden
Range(.Cells(3, 1), .Cells(Rows.Count, 2).End(xlUp).Offset(0, 3)).Sort _
Key1:=.Cells(4, 1), Order1:=xlAscending, Key2:=.Cells(4, 2) _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal
End With
Next
' überflüssige Blätter löschen
For k = .Worksheets.Count - UBound(myForms) To 1 Step -1
Application.DisplayAlerts = False
.Worksheets(k).Delete
Application.DisplayAlerts = True
Next
End With
errorHandler:
formCheck = False
Application.ScreenUpdating = True
' hier ein End, da die Formulare alle geladen wurden und
' nicht im Speicher bleiben sollen
' das könnte man natürlich auch über das Entladen aller Formulare erledigen
' nur wird dann u.U. unerwünschter Code ausgeführt
End
End Sub
Die Variable formCheck ist eine globale Variable (Deklaration habe ich jetzt hier nicht drin), deren Aufgabe ist einfach die Initialisierung der UserForms zu verhindern, d.h. am Anfang der Initialize-Prozeduren der UserForms kommt einfach
If formCheck then Exit Sub
Hintergrund ist, dass beim Auslesen der Controls die UserForms geladen werden und dabei evtl. Code ausgeführt wird, der nicht ausgeführt werden soll bzw. beim dem es zu Fehlermeldungen kommt. Ist das bei Dir nicht der Fall, dann kannst Du das auch einfach weglassen.
Gruß, Jogy