Ich habe - dank der Hilfe aus diesem Forum hier folgenden Makro - Code zusammengebastelt. Sicher nicht alles optimal gegliedert ... aber es läuft korrekt !
Mittels diesem Makro können alle Hyperlinks in einer grossen Arbeitsmappe geprüft werden. D.h. diverse Hyperlinks liegen wild verstreut in dieser grossen Excel-Arbeitsmappe (verteilt auf unzählige Tabellenblätter und wirr durcheinander in verschiedenen Zellen und Spalten).
Private Sub CommandButton1_Click()
Dim ausgabe As Workbook, ws As Worksheet, tb As Worksheet
Dim objHL As Hyperlink, zeile As Long
zeile = 2
Set ausgabe = Workbooks.Add
Set ws = ausgabe.Sheets(1)
With ws
.Cells(1, 1) = "Tabellenblatt"
.Cells(1, 2) = "Zellenadresse"
.Cells(1, 3) = "Hyperlink"
.Cells(1, 4) = "Hyperlinkadresse"
.Cells(1, 5) = "Status"
End With
With ThisWorkbook
For Each tb In .Sheets
For Each objHL In tb.Hyperlinks
ws.Cells(zeile, 1) = tb.Name
ws.Cells(zeile, 2) = objHL.Range.Address(0, 0)
ws.Cells(zeile, 3) = objHL.TextToDisplay
ws.Cells(zeile, 4) = objHL.Address
If InternetCheckConnection(objHL.Address, FIFC, 0&) = 0 Then
ws.Cells(zeile, 5) = "Fehlerhaft"
Else
ws.Cells(zeile, 5) = "OK"
End If
zeile = zeile + 1
Next
Next
End With
ws.Columns.AutoFit
ausgabe.Activate
'Formatieren der Ausgabe-Liste:
ws.Rows("1:1").Select
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 40
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
ws.Columns("C:C").Select
Selection.ColumnWidth = 120
ws.Cells.Select
ws.Range("C1").Activate
Selection.AutoFilter
ws.Range("C11").Select
ActiveWindow.SmallScroll ToRight:=4
Selection.AutoFilter Field:=5, Criteria1:="Fehlerhaft"
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.787401575)
.RightMargin = Application.InchesToPoints(0.787401575)
.TopMargin = Application.InchesToPoints(0.984251969)
.BottomMargin = Application.InchesToPoints(0.984251969)
.HeaderMargin = Application.InchesToPoints(0.4921259845)
.FooterMargin = Application.InchesToPoints(0.4921259845)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA3
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 2
.PrintErrors = xlPrintErrorsDisplayed
End With
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "Fehlerhafte Hyperlinks in der Wissensdatenbank SC SW"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = "Stand: &D"
.LeftMargin = Application.InchesToPoints(0.787401575)
.RightMargin = Application.InchesToPoints(0.787401575)
.TopMargin = Application.InchesToPoints(0.984251969)
.BottomMargin = Application.InchesToPoints(0.984251969)
.HeaderMargin = Application.InchesToPoints(0.4921259845)
.FooterMargin = Application.InchesToPoints(0.4921259845)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA3
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 2
.PrintErrors = xlPrintErrorsDisplayed
End With
ws.Range("A1").Select
End Sub
Der Code soll nun so erweitert / ergänzt werden, dass Hyperlinks, welche auf andere Stellen innerhalb dieser Arbeitsmappe führen - nicht als Fehler ausgegeben werden.
D.h. ich habe in meiner grossen Arbeitsmappe u.a. Hyperlinks welche bloss auf ein anderer Tabellenblatt führen, nicht aber ins Intranet, Sharepoint oder Internet ...
un diese Links sollen niemals als FEHLERHAFT ausgegeben werden.
Sie dienen ja bloss als Dokument-interne Sprung-Links
Wer kann mir dabei helfen ?
Hoffe, meine Frage war so einigermassen verständlich
Im voraus besten Dank !