Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
19.04.2024 17:05:40
Zählen von Zeilen, in denen in bestimmten Bereich Daten sind
19.04.2024 16:34:52
gemeinsamer Filter über drei Spalten
19.04.2024 15:39:42
Exceltabelle daten per combobox zu word Datei
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1600to1604
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1600to1604
1600to1604
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Hyperlinks reparieren / umbenennen

Hyperlinks reparieren / umbenennen
11.01.2018 07:28:57
Thomas
Guten Morgen zusammen.
Ich habe mal wieder ein Problem mit den Hyperlinks.
Aus irgendeinem Grund (vermutlich hin und her kopieren der Excel Tabelle) haben sich Hyperlinks geändert.
Alter (korrekter) Pfad: V:\Dateien\Ablage\Archiv\Stuttgart\D016\xxx.pdf
Neuer (falscher) Pfad: V:\Dateien\Ablage\Archiv\Archiv\Stuttgart\D016\xxx.pdf
Merkwürdigerweise sind aber nicht alle Hyperlinks betroffen.
Mir geht es jetzt darum, nur das eine "\Archiv" aus dem Link zu löschen.
Da es nicht alle Hyperlinks betrifft, würde ich die betroffenen Bereiche von Hand selektieren und dann nach dem Schema "For Each Hyperlink in Selection..." das zweite "\Archiv" aus dem Link löschen. Der Rest des Links sollte erhalten bleiben.
Leider bekomme ich ohne eure Hilfe den Code nicht hin.
Wäre toll, wenn mir dabei jemand helfen könnte.
Viele Grüße,
Thomas

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Hyperlinks reparieren / umbenennen
11.01.2018 08:45:52
Bernd
Hi,
lies mal hier und teste die kurze Variante:
http://www.office-loesung.de/ftopic68633_0_0_asc.php
Also so z.B.:
Option Explicit
Sub DoppelteWeg()
Dim dict As Object
Dim Zelle As Range
Dim Werte() As String
Dim i As Long
Const TRKz As String = "\"
For Each Zelle In Selection
Werte = Split(Zelle.Value, TRKz)
Set dict = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(Werte)
dict(Trim(Werte(i))) = 0
Next
Zelle.Value = Join(dict.Keys, TRKz)
Next
End Sub
MfG Bernd
Anzeige
AW: Hyperlinks reparieren / umbenennen
11.01.2018 09:10:46
Thomas
Hallo Bernd,
danke für Deine Hilfe.
Aber so geht es leider nicht. Ich hatte vergessen zu erwähnen, dass nicht der Hyperlink als Text in der Zelle steht, sondern ein Datum welches verlinkt ist.
Viele Grüße,
Thomas
AW: Hyperlinks reparieren / umbenennen
11.01.2018 08:48:17
Dieter(Drummer)
Guten Morgen Thomas,
machs doch mit "Suchen/ersetzen:
Suchen: \Archiv\Archiv\
Ersetzen: \Archiv\
Fertig.
Gruß, Dieter(Drummer)
AW: Hyperlinks reparieren / umbenennen
11.01.2018 09:06:50
Thomas
Hallo Dieter,
danke für die Antwort. Das geht leider nicht, da in den Zellen nicht der Hyperlink als Text steht, sondern dort ein Datum verlinkt ist. (Hätte ich vielleicht erwähnen sollen;-))
Grüße,
Thomas
Anzeige
AW: OK Thomas. Danke für Rückmeldung. owT
11.01.2018 09:14:55
Dieter(Drummer)
AW: Hyperlinks reparieren / umbenennen
11.01.2018 09:13:14
Thomas
Nachtrag!
In den Zellen steht nicht der Pfad zu den verlinkten Dateien, sondern ein Datum welches verlinkt ist.
Grüße,
Thomas
AW: Hyperlinks reparieren / umbenennen
11.01.2018 09:18:33
Thomas
Vergessen das Häkchen zu setzen...
AW: Hyperlinks reparieren / umbenennen
11.01.2018 12:04:29
Thomas
Hallo Firmus,
zunächst vielen Dank für Deine Hilfe.
Leider lässt unsere Firewall das öffnen der Datei nicht zu.
Kannst Du den Code posten?
Viele Grüße,
Thomas
AW: Hyperlinks reparieren / umbenennen (Code) owT
11.01.2018 12:35:24
firmus 

Option Explicit
Sub hyperlink_setzen()
Dim xAnzLinks As Long, x1 As Long, Zielspalte As Long
Dim ReplaceALT As String
Dim ReplaceNEU As String
Dim tmpC1 As String, tmpC2 As String
Zielspalte = 2  '2 = Spalte "B"
xAnzLinks = ActiveSheet.Hyperlinks.Count
ReplaceALT = "\Dateien\Ablage\Archiv\Archiv\"
ReplaceNEU = "\Dateien\Ablage\Archiv\"
For x1 = 1 To xAnzLinks
tmpC1 = ActiveSheet.Hyperlinks(x1).Address
If InStr(1, tmpC1, ReplaceALT)  0 Then                'nur ausgwählte Links ändern
MsgBox tmpC1
If ActiveSheet.Hyperlinks(x1).Parent.Column = Zielspalte Then
tmpC1 = Replace(tmpC1, ReplaceALT, ReplaceNEU)
MsgBox tmpC1
' HYPERLINK korrigieren
ActiveSheet.Hyperlinks(x1).Address = tmpC1
tmpC2 = "zeile " & ActiveSheet.Hyperlinks(x1).Parent.Row
tmpC2 = tmpC2 & "Spalte " & ActiveSheet.Hyperlinks(x1).Parent.Column
tmpC2 = tmpC2 & " am " & Date & " um " & Time
ActiveSheet.Hyperlinks(x1).ScreenTip = tmpC2
End If
End If
Next x1
End Sub

Anzeige
AW: Hyperlinks reparieren / umbenennen (Code) owT
11.01.2018 13:27:46
Thomas
Hallo Firmus,
hat super funktioniert. Du hast mir sicherlich etliche Stunden gerettet.
Ich habe nur die MsgBox herausgenommen (es waren einige hundert Links) und die Spalten per Schleife durchlaufen.
Den Code hätte ich niemals hinbekommen. Dazu reichen meine VBA-Kenntnisse dann doch (noch) nicht.
Also, besten Dank für Deine Mühe.
Viele Grüße,
Thomas

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige