Discussion :

[Rough43]

Bonjour à tous,

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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?
Et aussi en relançant ce macro, il se plante 1 sur 2?!?

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

Merci de votre aide

[casefayere]

Bonjour,
Essayes en adaptant, ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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 )

J'en ai un millier de liens hypertextes à verifier . 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