Namen in Datei auflisten, Namen löschen
01.08.2013 13:36:34
fcs
Hallo Julia,
das Deaktivieren der Alarm-Hinweise, kann auch direkt auf die Kopieranweisung beschränkt werden.
'gefilterte Daten der Abteilung kopieren
Application.DisplayAlerts = False
.Range(.Rows(1), .Rows(Zeile_H)).Copy wksAbt.Cells(1, 1)
Application.DisplayAlerts = True
Dann sollte keine Rückfrage bezüglich der Namen kommen.
Warum Namen mit kopiert werden, obwohl du die Namen angeblich gelöscht hast weiss ich nicht.
Nachfolgend zwei Makros, mit denen ich Infos zu Namen aus einer Exceldatei auslesen kann bzw. radikal alle Namen lösche.
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
Sub Datei_Namen_Loeschen()
'Erstellt 2012-06-02
'löscht in der aktiven Arbeitsmappe alle definierten Namen (auch unsichtbare!) _
- außer MS-geschützter Namen für Tabellen-Funktionen
On Error GoTo Fehler
Dim objName As Name
If ActiveWorkbook.Names.Count = 0 Then
MsgBox "In der aktiven Arbeitsmappe sind keine Namen vorhanden.", _
vbInformation + vbOKOnly, _
"Namen löschen"
GoTo Beenden
End If
If MsgBox("Alle Namen in aktiver Arbeitsmappe löschen?", _
vbQuestion + vbOKCancel, _
"Namen löschen") = vbCancel Then GoTo Beenden
For Each objName In ActiveWorkbook.Names
If LCase(Left(objName.Name, 6)) "_xlfn." Then
objName.Delete
End If
Next
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case 1004
MsgBox "Name """ & objName.Name & """ kann nicht gelöscht werden", _
vbInformation + vbOKOnly, "Namen in Mappe löschen"
Resume Next
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .description
End Select
End With
Beenden:
Set objName = Nothing
End Sub