Bei Namen gehen Bezüge auf Range verloren
29.07.2004 09:56:02
Glamour
Ich habe folgendes Problem:
In einer Arbeitsmappe liegt die Vorlage für eine Liste. Dieses Arbeitsblatt wird kopiert, umbenannt und mit Werten beschrieben. Damit in der Vorlage auch von weniger in VBA bewanderten Bearbeitern Änderungen vorgenommen werden können, soll der Verweis auf die zu beschreibenden Felder per "Namen" erfolgen.
Folgendes Problem: Beim Kopieren des Arbeitsblattes werden die "Namen" mitkopiert. Dabei ändern sich die Bezüge der Namen in völlig unsinnige Werte. z.B. wird B3 zu C4539 (z.B. heist: es kommt jedesmal was anderes dabei raus). Außerdem können Namen eh nur einmal in einer Arbeitsmappe vorkommen (glaube ich)
Das Problem will ich folgendermaßen umgehen:
-Array mit Namen und Bezügen füllen
-Alle Namen in der Arbeitsmappe löschen (damit sie nicht mitkopiert werden und sich dabei wie o.g. in Unsinn ändern)
-Blatt kopieren
-Namen wieder erstellen
-Namen, die auf das kopierte Blatt verweisen, im Array ändern (Namen und Bezug)
-Namen, die nicht auf das kopierte Blatt verweisen, im Array löschen
-Namen aus dem Array schreiben
Soweit sogut, der Code war recht schnell geschrieben. Allerdings habe ich jetzt folgendes Problem:
Wenn ich auf Namenelement.Value zugreife, steht da manchmal schon beim ersten mal ein falscher Wert drin. Gleiches bei Zugriff z.B. auf .RefersTo
Wie kann ich sicherstellen, dass Excel die Werte für die Bezüge nicht ändert?Ich dreh hier noch durch. Mein Excel hat ein Eigenleben, da versteht man die Welt nicht mehr. Wo wir schon dabei sind: Hat eigentlich noch jemand solche Probleme mit der .Find - Methode? Ich muss mir Schleifen bauen: .Find bis gefundener Wert = gesuchter Wert. Denn sonst erhält man manchmal einen völlig anderen Wert/Bezug. Und manchmal schmeisst die Methode einem dann einen Fehler an den Kopf, weil der Wert nicht gefunden wurde. Dabei steht er unverändert da wie immer. Aber so alle 10.000 Find-Methoden passierts dann, dass er nicht gefunden wird.
Ich hoffe mal, jemand kann mir helfen.
*Grummel* für solche Fehler sollte Microsoft jemanden mit dem Programm ausliefern, der einem permanent den Rücken massiert und gut zuredet.
Freu mich auf Eure Antworten,
Johannes
P.S.: Und hier noch der Code...
Private Function BlattMitNamenKopieren(ByVal QuellBlatt As Worksheet, ByVal sZielblatt As String)
'Kopiert ein Blatt und verändert die Namen und Bezüge für das neue Blatt
Dim aAlleNamen(250, 1) As String
Dim i As Integer
i = 0
'Namen im Blatt in Array einlesen
For Each Namenelement In QuellBlatt.Parent.Names
aAlleNamen(i, 0) = Namenelement.Name
aAlleNamen(i, 1) = Namenelement.Value
MsgBox (aAlleNamen(i, 0) & " " & aAlleNamen(i, 1))
i = i + 1
Next
'Namen in Blatt löschen
Do While QuellBlatt.Parent.Names.Count > 0
QuellBlatt.Parent.Names(1).Delete
Loop
'Blatt kopieren
QuellBlatt.Copy Sheets(1)
'Umbenennen
ActiveSheet.Name = sZielblatt
'Namen wieder schreiben
For i = 0 To 250
If Not (aAlleNamen(i, 0) = "") Then QuellBlatt.Parent.Names.Add aAlleNamen(i, 0), aAlleNamen(i, 1)
Next
'Namen für Ziel umwandeln
For i = 0 To 250
If Not (aAlleNamen(i, 0) = "") Then
If InStr(1, aAlleNamen(i, 1), QuellBlatt.Name) And Not (aAlleNamen(i, 0) Like "*_FilterDatabase") Then
aAlleNamen(i, 0) = sZielblatt & "_" & aAlleNamen(i, 0)
aAlleNamen(i, 1) = Replace(aAlleNamen(i, 1), QuellBlatt.Name, sZielblatt, , , vbTextCompare)
Else
aAlleNamen(i, 0) = ""
aAlleNamen(i, 1) = ""
End If
End If
Next
'Namen für Ziel schreiben
For i = 0 To 250
If Not (aAlleNamen(i, 0) = "") Then QuellBlatt.Parent.Names.Add aAlleNamen(i, 0), aAlleNamen(i, 1)
Next
End Function
Private Function BlattMitNamenLöschen(ByVal QuellBlatt As Worksheet)
'Wird ein Blatt, auf das Namen verweisen, gelöscht, bleiben die Namen
'bestehen, allerdings haben Sie den Bezug verloren. Um die Namen gleichzeitig
'mit dem Blatt zu löschen, wird diese Funktion verwendet
Dim aAlleNamen(250, 1) As String
Dim i
i = 0
For Each Namenelement In QuellBlatt.Parent.Names
aAlleNamen(i, 0) = Namenelement.Name
aAlleNamen(i, 1) = Namenelement.Value
MsgBox (aAlleNamen(i, 0) & " " & aAlleNamen(i, 1))
i = i + 1
'Namenelement.Delete
Next
'Namen löschen
Do While QuellBlatt.Parent.Names.Count > 0
QuellBlatt.Parent.Names(1).Delete
Loop
'Namen wieder erstellen, wenn sie nicht auf das zu Löschende Blatt verweisen
On Error Resume Next
For i = 0 To 250
If Not (InStr(1, aAlleNamen(i, 0), QuellBlatt.Name, vbTextCompare)) Then QuellBlatt.Parent.Names.Add aAlleNamen(i, 0), aAlleNamen(i, 1)
Next
On Error GoTo 0
Application.DisplayAlerts = False
QuellBlatt.Delete
Application.DisplayAlerts = True
End Function