Problème vérification lien hypertexte

Version imprimable

Bonjour à tous,:mrgreen:

je teste les liens hypertextes, contenues dans une colonne d'une feuille excel, qui sont rattachés à l'internat d'une entreprise. le principe est simple: à chaque cellule, on verifie si un lien hpertexte existe et si oui, on l'ouvre et le ferme aussitot. Si impossible de l'ouvrir, cette cellule est colorisée et on passe à la suite de l'opération. Voici le code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 Sub TestLienURL() 'ANALYSE ET DETECTION PB OUVERTURE LIEN Dim Maplage As Range Dim Cellule As Range Dim Message As String Dim i As Integer Application.DisplayAlerts = False 'Désactive les messages d'erreur 'Effacement couleur cellule Sheets("Manuel de processus").Select Columns("f").Select Selection.Interior.ColorIndex = xlNone Set Maplage = ActiveSheet.Range("f5:f65536") On Error GoTo GestionErreur 'quand excel rencontre l'erreur, il va lire la ligne GestionErreur For Each Cellule In Maplage 'pour chq cellule ds la plage URL_A_TESTER = Cellule.Value 'Verifie le lien If (IsEmpty(URL_A_TESTER)) Then 'si le lien URL n'existe pas alors Call Arret 'appelle procédure Arrêt Else 'Sinon Set fich = Workbooks.Open(URL_A_TESTER) 'ouvre l'URL fich.Close (False) 'ferme l'URL End If Next Cellule 'Va à la cellule suivante MsgBox "La vérification est terminée" Exit Sub GestionErreur: Cellule.Interior.ColorIndex = 38 'colorie la cellule en cas d'erreur Resume Next 'reprend à la ligne suivante Application.DisplayAlerts = True 'Réactive les messages d'erreur End Sub Sub Arret() Exit Sub End Sub
Or en ouvrant certaines fichiers .xls et/ou .doc en lecture seule, ces liens fonctionnent bien mais ce macro détecte en eux une erreur et colorise ces cellules...pourquoi?:roll:
Et aussi en relançant ce macro, il se plante 1 sur 2?!?8O

Remarque, pour les fichiers .pdf, ça fonctionne très bien!

Merci de votre aide

Bonjour,
Essayes en adaptant, ce code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
Dim maplage As Range, cellule As Range
Set maplage = ActiveSheet.Range("f5:f65536")
For Each cellule In maplage 
    If (IsEmpty(cellule)) Then 
    cellule.Interior.ColorIndex = 38 
    Else 'Sinon
    cellule.Hyperlinks(1).Follow
    End If
Next cellule
 
MsgBox "La vérification est terminée"
 
End Sub

Bonne journée

17/03/2010, 13h38
Rough43

Bonjour,

Je vous remercie d'apporter une réponse mais...celle là je la connaissais déjà et cela déclenche un message d'avertissement de MS office à chaque lien hypertexte : "Certains fichiers peuvent contenir des virus ou peuvent porter préjudice à votre ordinateur.Il est important de s'assurer de la fiabilité de leur source.
Voulez-vous ouvrir ce fichier?"

Pour éviter ce message d'avertissement , il aurait fallu modifier le registre du systeme d'ordi or il ya des dizaines...

Voilà pourquoi j'avais modifié ce code (voir le 1er message) mais le code detecte les erreurs dans les seuls liens hypertextes contenant des fichiers .xls ou .doc en mode lecture seule (pourtant ces liens fonctionnent bien 8O)

J'en ai un millier de liens hypertextes à verifier :roll:. Je ne comprends pas...

Je résume : ce code devait détecter les liens qui ne fonctionnent pas et coloriser les cellules qui contiennent ces liens défectueses.

Merci de votre compréhension