AW: alle Verknüpfungen in Datei anzeigen bzw löschen?
25.07.2003 08:43:32
Hajo_Zi
Hallo Kostro
falls es sich nur um eine Tabelle handelt. Lasse eins de beiden Makros laufen.
Option Explicit
Sub Verknüpfungen_löschen()
Dim c As Range
Dim frage
' ****
' Ergänzung Hajo
On Error GoTo Fehler1
' *****
For Each c In ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas)
If InStr(1, UCase(c.Formula), "XLS]") <> 0 Then
' c.Select
frage = MsgBox("Soll der Wert der Zelle" & Chr(13) _
& Chr(9) & c.Address & Chr(9) & c.FormulaLocal & Chr(13) _
& "als Zellwert eingetragen werden?" & Chr(13) & Chr(13) _
& "Bei ""Nein"" wird der Zellinhalt gelöscht", vbYesNo, _
"Verknüpfung als Wert schreiben?")
If frage = vbYes Then
c.Value = c.Text
Else
c.Value = ""
End If
End If
Next
' ****
' Ergänzung Hajo
Exit Sub
Fehler1:
MsgBox "Es sind keine Verknüpfungen vorhanden" & Chr(13) _
& "Schauen Sie mal unter Einfügen, Namen, Namen Definieren"
End Sub
' Es werden in der aktiven Arbeitsmappe ALLE Verknüpfungen entfernt.
' Du hast nur die Auswahl, ob Du den Wert behalten willst, oder ob die Zelle
' leer sein soll.
' von Berti
Sub Verknüpfungen_löschen2()
Dim c As Range
Dim frage
' ****
' Ergänzung Hajo
On Error GoTo Fehler1
' *****
For Each c In ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas)
If InStr(1, UCase(c.Formula), "XLS]") <> 0 Then
' c.Select
frage = MsgBox("Soll der Wert der Zelle" & Chr(13) _
& Chr(9) & c.Address & Chr(9) & c.FormulaLocal & Chr(13) _
& "als Zellwert eingetragen werden?" & Chr(13), vbYesNo, _
"Verknüpfung als Wert schreiben?")
If frage = vbYes Then
c.Value = c.Text
Else
' Ergänzung Hajo
' *******
frage = MsgBox("Soll die Verknüpfung erhalten bleiben" & Chr(13) _
& Chr(9) & c.Address & Chr(9) & c.FormulaLocal & Chr(13) & Chr(13) _
& "Bei ""Nein"" wird der Zellinhalt gelöscht", vbYesNo, _
"Verknüpfung erhalten?")
' *******
If frage = vbNo Then c.Value = ""
End If
End If
Next
' ****
' Ergänzung Hajo
Exit Sub
Fehler1:
MsgBox "Es sind keine Verknüpfungen vorhanden" & Chr(13) _
& "Schauen Sie mal unter Einfügen, Namen, Namen Definieren"
End Sub
' Es wird in der aktiven Arbeitsmappe bei ALLE Verknüpfungen gefragt ob ersetzen und
' dann ob Verknüpfung erhalten bleiben soll, bei Nein wird die Zelle leer
' von Berti
Sub Verknüpfte_Zellen()
' Verknüpfungen auflisten
Dim RaZelle As Range
Dim ByMldg As Byte
Dim Sh As Worksheet
For Each Sh In Worksheets
If InStr(Sh.Name, "Verknüpfungen") > 0 Then
ByMldg = MsgBox("Eine Tabelle mit dem Namen Verknüfungen ist schon" _
& " vorhanden, solleb die Daten gelöscht werden", vbYesNo + vbQuestion, "Löschabfrage ?", "", 0)
If ByMldg = 6 Then
Sh.Cells.Delete
ByMldg = 45
Exit For
Else
Exit Sub
End If
End If
Next Sh
If ByMldg <> 45 Then
Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Verknüpfungen"
End If
With Worksheets("Verknüpfungen")
.Cells(1, 1) = "Zelle"
.Cells(1, 2) = "Tabelle"
.Cells(1, 3) = "Formel"
For Each Sh In Worksheets
If Sh.Name <> "Verknüpfungen" Then
For Each RaZelle In Sh.UsedRange
If Left(RaZelle.Formula, 1) = "=" And _
InStr(RaZelle.Formula, ":\") > 1 Then
.Cells(.Range("A65536").End(xlUp).Row + 1, 1) = RaZelle.Address(0, 0)
.Cells(.Range("A65536").End(xlUp).Row, 2) = Sh.Name
.Cells(.Range("A65536").End(xlUp).Row, 3) = "'" & RaZelle.Formula
End If
Next RaZelle
End If
Next Sh
End With
End Sub
Code eingefügt mit: Excel Code Jeanie
Falls Code vorhanden wurde dieser getestet unter Betriebssystem XP Pro und Excel Version XP SBE.
Bitte kein Mail, Probleme sollen im Forum gelöst werden.
Microsoft MVP für Excel
Das Forum lebt auch von den Rückmeldungen.