AW: Infos zu Name(n), Name(n) löschen
19.09.2014 15:51:35
fcs
Hallo Ulrike,
das von dir beschriebenen Phänomen tritt eigentlich nicht auf, wenn komplette Tabellenblätter kopiert werden, sondern wenn ein Zellbereiche mit Namen in Formeln in eine andere Arbeitsmappe kopiert wird, die bereits identischen Namen enthält.
Nachfolgend zwei Makros, mit denen du Informationen zu den Namen in einer Arbeitsmappe auflisten lassen kannst bzw. zum Löschen von Namen (inkl. unsichtbarer Namen).
Gruß
Franz
Die Makros kopierst du am besten in ein allgemeines Modul deiner persönlichen Makro-Arbeitsmappe.
'##################################
Sub Namen_Listen_extern()
Call Namen_in_Arbeitsmappe_listen(wkb:=ActiveWorkbook, bName:=True, bVisible:=True, _
bRefersToLocalR1C1:=True, bParent:=True)
End Sub
Sub Namen_in_Arbeitsmappe_listen(Optional wkb As Workbook, _
Optional bName As Boolean, _
Optional bNameLocal As Boolean = True, _
Optional bRefersToLocal As Boolean = True, _
Optional bRefersToLocalR1C1 As Boolean, _
Optional bVisible As Boolean, _
Optional bParent As Boolean, _
Optional wks As Worksheet) 'wks = Zieltabelle für Informationen zu Namen
'Alle Namen der Arbeitsmappe werden mit Informationen in einem Tabellenblatt _
gelistet - über die Boolschen Werte wird festgelegt welche Informationen in der _
Liste ausgegeben werden.
Dim objName As Name, wbZiel As Workbook
Dim Z As Long, s As Long
On Error GoTo Fehler
If wkb Is Nothing Then Set wkb = ActiveWorkbook
If wkb.Names.Count > 0 Then
'ggf. neue Arbeitsmappe für Namens-Liste anlegen
If wks Is Nothing Then
Set wbZiel = Workbooks.Add(Template:=xlWBATWorksheet)
Set wks = wbZiel.Worksheets(1)
End If
With wks
Z = Z + 1
.Cells(Z, 1).Value = "Liste der Namen in Datei"
.Cells(Z, 2).Value = Now
Z = Z + 1
.Cells(Z, 1).Value = wkb.Name
'Spaltentitel
Z = Z + 2
s = 0
If bName Then s = s + 1: .Cells(Z, s).Value = "Name"
If bNameLocal Then s = s + 1: .Cells(Z, s).Value = "Name Local"
If bRefersToLocal Then s = s + 1: .Cells(Z, s).Value = "Refers to Local"
If bRefersToLocalR1C1 Then s = s + 1: .Cells(Z, s).Value = "Refers to R1C1Local"
If bVisible Then s = s + 1: .Cells(Z, s).Value = "Visible"
If bParent Then s = s + 1: .Cells(Z, s).Value = "Parent"
Cells(Z + 1, 2).Select
Application.ActiveWindow.FreezePanes = True
End With
For Each objName In wkb.Names
Z = Z + 1
s = 0
With objName
If bName Then s = s + 1: wks.Cells(Z, s).Value = "'" & .Name
If bNameLocal Then s = s + 1: wks.Cells(Z, s).Value = "'" & .NameLocal
If bRefersToLocal Then s = s + 1: wks.Cells(Z, s).Value = "'" & .RefersToLocal
If bRefersToLocalR1C1 Then s = s + 1: wks.Cells(Z, s).Value = "'" & .RefersToR1C1Local
If bVisible Then s = s + 1: wks.Cells(Z, s).Value = .Visible
If bParent Then s = s + 1: wks.Cells(Z, s).Value = "'" & .Parent.Name
End With
Next
wks.Range(wks.Columns(1), wks.Columns(s)).AutoFit
Else
MsgBox " Keine Namen in aktiver Datei definiert."
End If
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case 91
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description & vbLf & vbLf _
& "Es ist keine Arbeitsmappe aktiv"
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub
Sub Namen_loschen()
Call Namen_in_Arbeitsmappe_loeschen(wkb:=ActiveWorkbook, bolConfirm:=True)
End Sub
Sub Namen_in_Arbeitsmappe_loeschen(Optional wkb As Workbook, _
Optional bolConfirm As Boolean = True)
'Namen in der Arbeitsmappe löschen
Dim objName As Name, strMsg As String, bolLoeschen As Long
On Error GoTo Fehler
If wkb Is Nothing Then Set wkb = ActiveWorkbook
If wkb.Names.Count > 0 Then
'ggf. neue Arbeitsmappe für Namens-Liste anlegen
For Each objName In wkb.Names
With objName
If Left(.Name, 6) = "_xlfn." Then
'Name nicht löschen - Sytemname für neue Funktionen, wenn im Altformat gespeichert _
wird
ElseIf InStr(1, .Name, "!_FilterDatabase") > 0 _
Or InStr(1, .Name, "!Criteria") > 0 _
Or InStr(1, .Name, "!Extract") > 0 Then
'Filter-Datenbereich, Kriterien und Zielbereich nicht löschen
ElseIf InStr(1, .Name, "!Print_Area") > 0 Then
'Druckbereich nicht löschen
ElseIf InStr(1, .Name, "!Print_Titles") > 0 Then
'Drucktitel nicht löschen
Else
If bolConfirm = True Then
strMsg = "Name: " & .Name
strMsg = strMsg & vbLf & "NameLocal: " & .NameLocal
strMsg = strMsg & vbLf & "RefersToLocal: " & .RefersToLocal
strMsg = strMsg & vbLf & "Sichtbar: " & .Visible
strMsg = strMsg & vbLf & "Parent-Name: " & .Parent.Name
bolLoeschen = MsgBox(strMsg, vbQuestion + vbYesNoCancel, "Name-Löschen")
Else
bolLoeschen = vbYes
End If
Select Case bolLoeschen
Case vbYes
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
Case vbNo
Case vbCancel
Exit For
End Select
End If
End With
Next
Else
MsgBox " Keine Namen in aktiver Datei definiert."
End If
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case 91
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description & vbLf & vbLf _
& "Es ist keine Arbeitsmappe aktiv"
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub