Guten Tag miteinander
Dank der grossartigen Unterstützung hier im Forum hab ich in einer grossen Excel-Datenbank (unzählige Tabellenblätter)
nun eine Möglichkeit gebastelt, in dieser grossen Datenbank drin auf allen Registern/Tabellenblätter alle vorhandenen Hyperlinks zu Prüfen ob die
noch an ein Ziel führen.
Die Hyperlinks stehen auf den einzelnen Tabellenblättern nie an gleicher Stelle, sondern können wild auf dem Tabellenblatt verstreut sein.
Der untenstehende Code funktioniert prima !
Nach Start der Userform werden zuerst alle gefundenen Tabellenblätter der aktuellen Excel-Arbeitsmappe zur Auswahlliste hinzugefügt.
Ich kann dann in dieser Liste gewünschte Einträge selektieren/anwählen.
Diese Tabellenblätter werden dann durch das Programm nicht geprüft.
Nun meine Frage:
Gibt es irgendwie eine Möglichkeit, im Programm-Code (oder sonst wie) bestimmte Einträge (also Tabellenblätter) bereits nach Programm-Start immer schon
markiert und ausgewählt zu haben ?
Kann man bestimmte Tabellenblätter-Namen im Code hinterlegen, damit diese immer schon als blau markiert in der Liste erscheinen ?
Evt. kann mir sogar noch jemand verraten, was ich tun könnte, damit die ganze Prüferei auch etwas schneller läuft ?
In meiner aktuellen Arbeitsmappe gibt es 96 Tabellenblätter. Auf jedem Tabellenblatt hat es mindestens 3-4 Hyperlinks welche geprüft werden.
Wenn ich den untenstehenden Code (dieser steht bei mir hinter einer Userform mit Auswahlliste und zwei Command-Buttons) starte, so dauert die ganze Prüferei mindestens 4 Minuten.
Im voraus herzlichen Dank für all Eure Tips !
Private Sub CommandButton1_Click()
Dim shLinkList As Worksheet
Dim L As Long, lngIndex As Long
Dim HL As Hyperlink
Application.DisplayAlerts = False
Set shLinkList = Worksheets.Add(, Sheets(Sheets.Count))
With ListBox1
For lngIndex = 0 To .ListCount - 1
If Not .Selected(lngIndex) Then
If .List(lngIndex, 0) shLinkList.Name Then
For Each HL In Sheets(.List(lngIndex, 0)).Hyperlinks
L = L + 1
shLinkList.Cells(L, 1) = Sheets(.List(lngIndex, 0)).Name
If TypeOf HL.Parent Is Range Then
shLinkList.Cells(L, 2) = HL.Parent.Address
Else:
shLinkList.Cells(L, 2) = HL.Parent.Name
End If
shLinkList.Cells(L, 3) = HL.Address
shLinkList.Cells(L, 4) = (CheckLink(HL.Address) = 200)
Next
End If
End If
Next
End With
Set shLinkList = Nothing
frmCheckLinks.Hide
Application.DisplayAlerts = True
End Sub
Private Sub CommandButton2_Click()
frmCheckLinks.Hide
End Sub
Private Sub UserForm_Activate()
Dim objSh As Worksheet
frmCheckLinks.Caption = "Hyperlinks überprüfen/testen"
For Each objSh In ThisWorkbook.Worksheets
ListBox1.AddItem objSh.Name
Next
End Sub