Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1380to1384
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
Inhaltsverzeichnis

Hyperlinks entfernen/Bilder löschen per Makro

Hyperlinks entfernen/Bilder löschen per Makro
11.09.2014 22: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

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

Betreff
Datum
Anwender
Anzeige
AW: Hyperlinks entfernen/Bilder löschen per Makro
11.09.2014 22: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 08: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 08: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

sorry doppelt
12.09.2014 08:36:11
Christian
.

AW: sorry doppelt
12.09.2014 11: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 11: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

18 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige