Controle werking hyperlinks via Excel formule of VBA

[BarbaraC]

Beste,

Ik heb in Excel een kolom A met opsomming van hyperlinks (verwijzingen naar diverse bestanden op Windows Verkenner), maar een aantal van die hyperlinks werken niet meer (want bestand bestaat niet meer). Ik kan onmogelijk ze 1 voor 1 aanklikken om te zien of ze nog bestaan.. Bestaat er een formule of een VBA-code om dit snel weer te geven?

Alvast bedankt

 

[JEC.]

Heb je een hyperlink functie gebruikt of een directe link gemaakt? Ofwel, is je complete file pad zichtbaar in de cellen?

 

[BarbaraC]

Heb je een hyperlink functie gebruikt of een directe link gemaakt? Ofwel, is je complete file pad zichtbaar in de cellen?

Een directe link, dus het filepad is enkel te zien als je rechtsklikt en dan 'hyperlink bewerken'.
(bovendien - mocht dit relevant zijn - is de hyperlink bij 'hyperlink bewerken' niet volledig leesbaar, het staat bvb. als : "..\..\..\..\Q-management\Onderhoud\Machines\1120.doc". Maar deze opent wel, dus het werkt wel...)

De hyperlinkfunctie werd dus niet gebruikt.

 

[JEC.]

Als je dit runt, wordt de hyperlink gewoon verwijderd. De tekst blijft wel staan.
Kan je ook verwijderen als je wilt met een extra regeltje code

Sub jec()
 Dim it
 For Each it In Sheets(1).UsedRange.Resize(, 1)
   With it.Hyperlinks
     If .Count Then
       If Dir(.Item(1).Address) = "" Then .Item(1).Delete
     End If
   End With
 Next
End Sub

 

[BarbaraC]

Dankjewel @JEC. Dat werkt inderdaad.
En hoe kan ik aanduiden waar er hyperlinks te kort zijn?
Bvb. worden in kleur gezet (en daarop filteren)
of een formule in kolom B (en daarop filteren)

 

[snb]

Sub M_snb()
  For Each it In Sheet1.Hyperlinks
      If Dir(it.Address) = "" Then it.Delete
  Next
End Sub

 

[BarbaraC]

Dankjewel @JEC. Dat werkt inderdaad.
En hoe kan ik aanduiden waar er hyperlinks te kort zijn?
Bvb. worden in kleur gezet (en daarop filteren)
of een formule in kolom B (en daarop filteren)

Ik heb hier nog geen antwoord mogen op ontvangen.
Iemand?

 

[AHulpje]

Zo:

Sub jec()
 Dim it
 For Each it In Sheets(1).UsedRange.Resize(, 1)
   With it.Hyperlinks
     If .Count Then
       If Dir(.Item(1).Address) = "" Then
        .Item(1).Delete
        it.Interior.Color = vbRed
        End If
     End If
   End With
 Next
End Sub