Hallo,
leider hat es jetzt etwas gedauert bis ich mich wieder melden konnte. Noch mal vielen Dank für die Hinweise. Da ich nicht so viel Erfahrung mit Excel habe, hat mir der Code hier um einiges weitergeholfen. Die folgenden Makros werde ich jetzt in einem VB Programm zusammenfassen, um Exceldateien zu archivieren und möglichst unverändert wieder aufzurufen. Sollte jemandem noch Funktionen von Excel einfallen, die eventuell eine automatische Aktualisierung oder Verweise auf andere Dateien enthalten, dann bin ich immer für Hinweise dankbar.
Liebe Grüsse
Asgard (ahallmann)
'Hier die Makros, falls es jemanden interessiert:
Option Explicit
'Für diese Verweise habe ich keine Möglichkeit ausmachen können, sie zu deaktivieren und trotzdem
'im Sheet stehen zu lassen ohne sie vollständig zu verfremden.
Sub Hyperlink_markieren()
Dim str_var As String
Dim hypLink As Hyperlink
Dim zaehler As Long
Dim rngLinks As Range
zaehler = 1
For Each hypLink In ActiveSheet.Hyperlinks
If zaehler = 1 Then
Set rngLinks = hypLink.Range
->hypLink.Delete
zaehler = 0
Else
Set rngLinks = Application.Union(rngLinks, hypLink.Range)
End If
Next hypLink
If Not rngLinks Is Nothing Then
rngLinks.Select
->können nur markiert oder gelöscht werden, da sie sonst immer interpretiert werden
->rngLinks.Delete
End If
Set rngLinks = Nothing
End Sub
'Ole und Excel Links aufheben
'LinkSources im aktuellen Workbook aufheben
Sub LinkSources_Umwandlen()
Dim Link_array As Variant
Dim zaehler As Integer
Dim Anzahl As Integer
Dim test As String
Dim sheet_select As Variant
Dim Found_Link As Variant
zaehler = 0
Anzahl = 0
Link_array = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(Link_array) Then
Anzahl = UBound(Link_array)
For zaehler = 1 To Anzahl
ActiveWorkbook.BreakLink _
Name:=Link_array(zaehler), _
Type:=xlLinkTypeExcelLinks
Next zaehler
End If
Link_array = ActiveWorkbook.LinkSources(xlOLELinks)
If Not IsEmpty(Link_array) Then
Anzahl = UBound(Link_array)
For zaehler = 1 To Anzahl
ActiveWorkbook.BreakLink _
Name:=Link_array(zaehler), _
Type:=xlLinkTypeOLELinks
Next zaehler
End If
End Sub
'Sucht und findet Cells mit =Hyperlink, Ergänzungstext müsste nicht sein
Sub ExternemVerweisErsetzen()
Dim ws As Worksheet, b_Ersetzen As Boolean
->für alle Arbeitsblätter der aktiven Mappe
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
If VERWEISE_aufheben = True Then
->Zelle mit Verweisen kopieren
Selection.Copy
->Inhalte einfügen -> Werte
Selection.PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
End If
Next
AUFRAEUMEN:
Set ws = Nothing
End Sub
Private Function VERWEISE_aufheben() As Boolean
VERWEISE_aufheben = False
If HYPERTEXT_aufheben = True Then VERWEISE_aufheben = True
If HEUTE_aufheben = True Then VERWEISE_aufheben = True
End Function
'also das mit den Farben ist hauptsächlich Spielerei, ein bisschen Spass muss ja auch sein...
Private Function HYPERTEXT_aufheben() As Boolean
'alle Formeln des Blattes werden markiert,
'die eine externen Verweis einhalten
'**********************************************************
Dim str_var As String
Dim rngLinks As Range, Zelle As Range
Dim l_cnt As Long
Dim inhalt As String
Dim pos1, pos2, pos3 As Long
'Formeln mit HYPERLINK suchen
l_cnt = 0->Zaehler initialisieren
For Each Zelle In ActiveSheet.UsedRange
If Left(Zelle.Formula, 1) = = Then
pos1 = InStr(1, Zelle.Formula, HYPERLINK)
If (pos1 > 0) Then
->gesamte Formelzeile as Value speichern, wandelt
->auch in der Tabelle den Text von Text- zur Linkdarstellung
Zelle.Value = Zelle.Formula
pos2 = InStr(1, Zelle.Formula, ,)
str_var = Mid(Zelle.Formula, pos1 + 11, pos2 - pos1 - 12)
Zelle.Value = Zelle.Value + VERWEIS AUFGEHOBEN:-> + str_var +->
->Zelle als Selektion setzen
l_cnt = l_cnt + 1
If l_cnt = 1 Then
Set rngLinks = Zelle.Cells
Else
Set rngLinks = Application.Union(rngLinks, Zelle.Cells)
End If
End If
End If
Next
'gefundene Zellen umformatieren und markieren
If l_cnt > 0 Then
rngLinks.Select
rngLinks.Interior.ColorIndex = 35
rngLinks.Font.ColorIndex = 46
Set rngLinks = Nothing
HYPERTEXT_aufheben = True
Else
HYPERTEXT_aufheben = False
End If
End Function
Private Function HEUTE_aufheben() As Boolean
'alle Formeln des Blattes werden markiert,
'die eine externen Verweis einhalten
'**********************************************************
Dim str_var As String
Dim rngLinks As Range, Zelle As Range
Dim l_cnt As Long
Dim inhalt As String
Dim pos1, pos2, pos3 As Long
'Formeln mit HYPERLINK suchen
l_cnt = 0->Zaehler initialisieren
For Each Zelle In ActiveSheet.UsedRange
If Left(Zelle.Formula, 1) = = Then
pos1 = InStr(1, Zelle.Formula, TODAY())
If (pos1 > 0) Then
->Zelle als Selektion setzen
l_cnt = l_cnt + 1
If l_cnt = 1 Then
Set rngLinks = Zelle.Cells
Else
Set rngLinks = Application.Union(rngLinks, Zelle.Cells)
End If
End If
End If
Next
For Each Zelle In ActiveSheet.UsedRange
If Left(Zelle.Formula, 1) = = Then
pos1 = InStr(1, Zelle.Formula, NOW())
If (pos1 > 0) Then
->Zelle als Selektion setzen
l_cnt = l_cnt + 1
If l_cnt = 1 Then
Set rngLinks = Zelle.Cells
Else
Set rngLinks = Application.Union(rngLinks, Zelle.Cells)
End If
End If
End If
Next
'gefundene Zellen umformatieren und markieren
If l_cnt > 0 Then
rngLinks.Select
rngLinks.Interior.ColorIndex = 35
rngLinks.Font.ColorIndex = 46
Set rngLinks = Nothing
HEUTE_aufheben = True
Else
HEUTE_aufheben = False
End If
End Function
