Phantomverknüpfungen nach Verk. entfernen Makro!?
04.03.2005 09:25:42
DonFiala
Mit Hilfe des Forums habe ich nach und nach folgendes schönes Makro gebastelt!
Nach den Zeilen in denen "Herber Programm" steht ist ein Makro Teil der Verknüpfungen zur urspünglichen Arbeitsmappe entfernt und durch Werte ersetzt. Nun dachte ich, dass dieses Makro aber auch Formeln durch Werte ersetzt, was es leider nicht tut. Wenn ich die neu erzeugte Mappe öffne, werde ich daher immer gefrag ob die Werte aktualisiert werden sollen und dass die Datei Verknüpfungen zu anderen Datenquellen enthält! Wenn ich unter Bearbeiten und Verknüpfungen nachsehe wird auch eine Verknüpfung angezeigt, wenn ich aber mit dem Makro "huhu" suche findet er nix. Wenn ich ne künstliche Verknüpfung erzeuge und mit "huhu" suche findet er schon was! Wie kann das sein? Ich benutze Autofilter, Gruppierungen und Hyperlinks! Kannst daran liegen? Weiss keinen Rat mehr, bitte um Hilfe!
Sub huhu()
Dim Zelle As Range
'erste Verknüpfung finden
Set Zelle = Cells.Find(What:="]", LookIn:=xlFormulas)
If Not Zelle Is Nothing Then
Do
Zelle = "huhu"
'Zelle = Zelle.Value
Set Zelle = Cells.FindNext(Zelle)
Loop While Not Zelle Is Nothing
End If
End Sub
Sub SpeichernManuell()
ActiveSheet.Copy
ActiveSheet.Unprotect "DonFiala"
' Wartepopup Herber
Dim WsShell, Rück%
Set WsShell = CreateObject("WScript.Shell")
Rück = WsShell.Popup("Datei wird für Speicherung vorbereitet. Bitte einen Augeblick Geduld...", 5 _
, "Überschrift ...")
' Die 5 in der letzten Zeile gibt die Dauer der Öffnung an.
' Rück ist -1 wenn keine Taste gedrückt wurde
' Rück ist 1 wenn OK gedrückt wurde
' Herber Programm
Dim Zelle As Range
'erste Verknüpfung finden
Set Zelle = Cells.Find(What:="]", LookIn:=xlFormulas)
If Not Zelle Is Nothing Then
Do
Zelle = Zelle.Value
Set Zelle = Cells.FindNext(Zelle)
Loop While Not Zelle Is Nothing
End If
' Speicherprogramm
Dim DName As String, Dateiname As String, Pfad As String
Pfad = Range("Y7")
DName = Range("V6")
Dateiname = Pfad & "\" & DName & Format(Range("G7"), "YYYY.MMM") & ".xls"
' Tagesdatum als "Jahr.Monat.Tag" wegen Exploreransicht!
' InfopopupProgramm für Abbrechen und für nicht Speichern
On Error GoTo Fehler
ArbVerz = CurDir
ChDir Pfad
ChDir ArbVerz
ActiveWorkbook.SaveAs Filename:=Dateiname
MsgBox "Datei wurde erfolgreich unter dem Namen " & ActiveWorkbook.Name & " gespeichert."
ActiveWorkbook.Close
Exit Sub
Fehler:
If Err.Number = 1004 Then
MsgBox "Datei nicht gespeichert"
Else
MsgBox Err.Description: 'Exit Sub
End If
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
End Sub
Gruss michi