Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1380to1384
1380to1384
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Anzeige
Inhaltsverzeichnis

Hyperlinks entfernen/Bilder löschen per Makro

Forumthread: Hyperlinks entfernen/Bilder löschen per Makro

Hyperlinks entfernen/Bilder löschen per Makro
12.09.2014 00:27:16
Christian
Hallo an alle,
seid ihr so nett und helft mir, unten stehendes Makro zu ändern? In sofern, dass bevor es das tut, was es im Moment tut im Sheet 1 alle Hyperlinks in den Spalten B und D entfernt, sowie alle Bilder entfernt.
Gruß und vielen Dank
Christian
Sub aa()
Dim hl As Hyperlink, s, ttd
For Each hl In Sheets(1).Hyperlinks
On Error Resume Next
ttd = hl.TextToDisplay
On Error GoTo 0
If ttd Like ("Season*") Or ttd Like ("Episode*") Then
s = Split(hl.Address, "/")
s = s(UBound(s) + (s(UBound(s)) = ""))
With Sheets(2).Cells(Rows.Count, 1).End(xlUp)
.Offset(1) = s
.Offset(1, 2) = hl.Parent.Offset(2)
End With
End If
Next
With Sheets(2)
.Range("A:G").Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlNo
End With
With Sheets(1)
.Cells.Clear
End With
End Sub

Anzeige

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Hyperlinks entfernen/Bilder löschen per Makro
12.09.2014 00:43:47
Martin
Hallo Christian,
hier mein Vorschlag:
Sub aa()
Dim hl As Hyperlink, s, ttd
Dim objElement As Object
With Sheets(1)
'Hyperlinks löschen
.Columns("B:B,D:D").Hyperlinks.Delete
'Alle Bilder löschen
For Each objElement In .Pictures
objElement.Delete
Next
End With
For Each hl In Sheets(1).Hyperlinks
On Error Resume Next
ttd = hl.TextToDisplay
On Error GoTo 0
If ttd Like ("Season*") Or ttd Like ("Episode*") Then
s = Split(hl.Address, "/")
s = s(UBound(s) + (s(UBound(s)) = ""))
With Sheets(2).Cells(Rows.Count, 1).End(xlUp)
.Offset(1) = s
.Offset(1, 2) = hl.Parent.Offset(2)
End With
End If
Next
With Sheets(2)
.Range("A:G").Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlNo
End With
With Sheets(1)
.Cells.Clear
End With
End Sub
Viele Grüße
Martin

Anzeige
AW: Hyperlinks entfernen/Bilder löschen per Makro
12.09.2014 10:22:50
Christian
Hallo Martin,
Excel sagt mir leider, irgendwelche Typen wären unverträglich.
Wenn ich vor die Zeile .Columns("B:B,D:D").Hyperlinks.Delete ein ' setze funktioniert es, außer dass er natürlich keine Links löscht.
Danke schonmal
Christian

AW: Hyperlinks entfernen/Bilder löschen per Makro
12.09.2014 10:35:22
Christian
Hallo Martin,
Excel sagt mir leider, irgendwelche Typen wären unverträglich.
Wenn ich vor die Zeile .Columns("B:B,D:D").Hyperlinks.Delete ein ' setze funktioniert es, außer dass er natürlich keine Links löscht.
Danke schonmal
Christian

Anzeige
sorry doppelt
12.09.2014 10:36:11
Christian
.

AW: sorry doppelt
12.09.2014 13:25:44
Martin
Hallo Christian,
ja, das war ein Fehler von mir. So sollte es aber wirklich klappen:
Sub aa()
Dim hl As Hyperlink, s, ttd
Dim objElement As Object
With Sheets(1)
'Hyperlinks löschen
.Range("B:B,D:D").Hyperlinks.Delete
'Alle Bilder löschen
For Each objElement In .Pictures
objElement.Delete
Next
End With
For Each hl In Sheets(1).Hyperlinks
On Error Resume Next
ttd = hl.TextToDisplay
On Error GoTo 0
If ttd Like ("Season*") Or ttd Like ("Episode*") Then
s = Split(hl.Address, "/")
s = s(UBound(s) + (s(UBound(s)) = ""))
With Sheets(2).Cells(Rows.Count, 1).End(xlUp)
.Offset(1) = s
.Offset(1, 2) = hl.Parent.Offset(2)
End With
End If
Next
With Sheets(2)
.Range("A:G").Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlNo
End With
With Sheets(1)
.Cells.Clear
End With
End Sub
Viele Grüße
Martin

Anzeige
AW: sorry doppelt
12.09.2014 13:38:02
Christian
Hallo Martin,
Fehler können passieren. Überhaupt kein Problem. So funktioniert es jedenfalls.
Auf jeden Fall vielen Dank für deine Mühe und ein schönes Wochenende.
Gruß
Christian
Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Live-Forum - Die aktuellen Beiträge
Datum
Titel
14.05.2026 13:31:09
Zeichen ausblenden
14.05.2026 09:50:42
Makro für MacOs
13.05.2026 19:14:18
Gleichheitszeichen
13.05.2026 14:24:56
VBA Projekt Passwort automatisch eingeben
13.05.2026 08:49:41
Reale Berechnung ohne Nachkommawerte
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum