Makro Namen in Mappe listen
02.06.2012 17:33:57
fcs
Hallo Reinhard,
nachdem du endlich dem Problem auf die Schliche gekommen bist kann der Thread ja geschlossen werden.
Als Goody hier noch ein Makro, das alle Namen (inkl. der nicht sichtbaren) in der aktiven Arbeitsmappe in einem externen Tabellenblatt listet.
Gruß
Franz
Sub Datei_Namen_listen()
'Alle Namen in der aktiven Arbeitsmappe werden mit Zusatzinformation _
in einer Tabelle in einer neuen Arbeitsmappe gelistet.
Dim objName As Name, wbAktiv As Workbook, wbZiel As Workbook, wksZiel As Worksheet
Dim lngZei As Long
On Error Resume Next
Set wbAktiv = ActiveWorkbook
If wbAktiv.Names.Count = 0 Then
MsgBox "Keine Namen in Datei """ & wbAktiv.Name & """", vbInformation + vbOKOnly, "Namen _
auslesen"
GoTo Beenden
End If
'Neue Arbeitsmappe für Namens-Liste anlegen
Set wbZiel = Workbooks.Add(Template:=xlWBATWorksheet)
Set wksZiel = wbZiel.Worksheets(1)
Application.ScreenUpdating = False
With wksZiel
lngZei = lngZei + 1
.Cells(lngZei, 1).Value = "Liste der Namen in Datei"
lngZei = lngZei + 1
.Cells(lngZei, 1).Value = wbAktiv.Name
'Spaltentitel
lngZei = lngZei + 1
.Cells(lngZei, 1).Value = "Name"
.Cells(lngZei, 2).Value = "Name Local"
.Cells(lngZei, 3).Value = "Refers to Local"
.Cells(lngZei, 4).Value = "Refers to R1C1Local"
.Cells(lngZei, 5).Value = "Visible"
.Cells(lngZei, 6).Value = "Parent"
.Cells(lngZei, 7).Value = "Category"
.Cells(lngZei, 8).Value = "MacroType"
Cells(lngZei + 1, 2).Select
Application.ActiveWindow.FreezePanes = True
For Each objName In wbAktiv.Names
lngZei = lngZei + 1
.Cells(lngZei, 1).Value = "'" & objName.Name
.Cells(lngZei, 2).Value = "'" & objName.NameLocal
.Cells(lngZei, 3).Value = "'" & objName.RefersToLocal
.Cells(lngZei, 4).Value = "'" & objName.RefersToR1C1Local
.Cells(lngZei, 5).Value = objName.visible
With .Cells(lngZei, 6)
If objName.Parent.Name = wbAktiv.Name Then
.Value = "Datei: "
Else
.Value = "Tabelle: "
End If
.Value = .Value & objName.Parent.Name
End With
.Cells(lngZei, 7).Value = objName.Category
.Cells(lngZei, 8).Value = objName.MacroType
Next
.Range(.Columns(1), Columns(8)).AutoFit
End With
wbZiel.Activate
Beenden:
Application.ScreenUpdating = True
Set wbAktiv = Nothing: Set wbZiel = Nothing: Set wksZiel = Nothing: Set objName = Nothing
End Sub