Problème avec mon code

[Fanfan68]

Bonjour à tout le monde,

Grâce à l'aide du forum, j'ai concocté ce petit programme me permettant de vérifier si le lien est toujours valide ou si il existe, dans le cas contraire, je demande à l'utilisateur d'aller à l'endroit ou le fichier se trouve afin de le créer ou le re-créer.

Dim c As Range
For Each c In Range("H6:H" & Sheets("Tableau").Range("H65536").End(xlUp).Row
On Error Resume Next
GetAttr c.Hyperlinks(1).Address
If Err.Number = 0 Then
Range("i1").Value = ""
Else
MsgBox "Le lien pointant sur le fichier nommé " & c.Value & " est rompu ou le fichier n'est plus dans le même emplacement, cliquez sur OK pour le créer ou le re créer", vbCritical, "Lien invalide - Hydro Plumbing"
ouvrir = Application.GetOpenFilename(filefilter:="tout,*.*", Title:="Sélection")
If ouvrir = Faux Then Exit Sub
With ActiveSheet
d = ouvrir
b = c.Address
a = c.Value
.Hyperlinks.Add .Range(b), d, TextToDisplay:=a
End With
End If
On Error GoTo 0
Next c

Le code fonctionne bien et si je le lance 10 fois, ça va fonctionner, par contre, le problème, c'est que si, pour tester, je déplace un fichier ou est sensé pointer un lien et que je relance la routine, le programme va bien détecter que le lien est rompu mais il va également détecter que les autres liens le sont aussi alors que ce n'est pas le cas et ce même si je ferme le fichier et que je le ré ouvre

Auriez vous une soluce pour un homme à la dérive....

 

[Gorfael]

Re : Problème avec mon code

Bonjour à tout le monde,

Grâce à l'aide du forum, j'ai concocté ce petit programme me permettant de vérifier si le lien est toujours valide ou si il existe, dans le cas contraire, je demande à l'utilisateur d'aller à l'endroit ou le fichier se trouve afin de le créer ou le re-créer.

Dim c As Range
...

Le code fonctionne bien et si je le lance 10 fois, ça va fonctionner, par contre, le problème, c'est que si, pour tester, je déplace un fichier ou est sensé pointer un lien et que je relance la routine, le programme va bien détecter que le lien est rompu mais il va également détecter que les autres liens le sont aussi alors que ce n'est pas le cas et ce même si je ferme le fichier et que je le ré ouvre

Auriez vous une soluce pour un homme à la dérive....

Salut
Comme je n'aime pas me servir des erreurs (je préfères les éviter), je ne suis pas sûr : Quand tu détectes l'erreur, l'objet error se charge, mais tant qu'il ne détecte pas une erreur nouvelle ou une sortie de procédure, il continue à être chargé
Donc, je placerais un Err.Clear juste avant le next
A+

 

[Fanfan68]

Re : Problème avec mon code

Merci Gorfael pour la promptitude de ta réponse, néanmoins, j'ai effectivement eu le tuyau hier et ce matin, en arrivant au bureau, j'ai donc rajouté ce petit morceau de code non pas avant le "next" mais avant le "On Error Resume Next" mais rien n'y a changé.

Je te rappel que j'ai essayé cela ce matin, donc j'ai du ré ouvrir le fichier que j'avais fermé hier...etc etc, ce qui veut dire, qu'en plus il le garde en mèmoire.

Suite à ta réponse, j'ai bien évidemment essayé en le mettant avant le next mais idem, vraiment je ne comprend pas, d'autant plus que si je clique sur le lien, le fichier s'y trouve bien alors que le code me dit qu'il n'est pas valide.

 

[Luki]

Re : Problème avec mon code

Bonjour fanafan, gorfael,

Sauf erreur le "on error resume next" réinitialise l'erreur à zéro, donc pas utile d'ajouter un "clear".

par contre fanfan pourquoi :

Dim c As Range
For Each c In Range("H6:H" & Sheets("Tableau").Range("H65536").End(xlUp).Row
On Error Resume Next
GetAttr c.Hyperlinks(1).Address
If Err.Number = 0 Then
Range("i1").Value = "" C'est quoi i, et pourquoi ce value ="" ? bizarre, bizarre.

Je fais des essais et je ne comprends pas tout.
A te lire

 

[Luki]

Re : Problème avec mon code

Re
autre chose que j'ai vu.

Si je déplace un fichier sur le quel pointe un lien et que je lance la macro sans fermer le fichier auparavant, pas d'erreur, comme si les liens n'étaient pas rafraîchis "dynamiquement", il y a peut-être à chercher de ce côte....

A+

 

[Fanfan68]

Re : Problème avec mon code

Bonjour Luki,

En fait le Range("i1").Value = "" c'est la cellule i1 et cela me sert uniquement à mettre quelque chose pour la condition car je ne savais pas si je pouvais laisser vide :

If Err.Number = 0 Then
"Vide ici"
Else
MsgBox "Le lien pointant sur le fichier nommé " & c.Value & " est rompu ou le fichier n'est plus dans le même emplacement, cliquez sur OK pour le créer ou le re créer", vbCritical, "Lien invalide - Hydro Plumbing"

Une autre précision, comme je l'ai dit, le programme ne trouve pas le fichier ou pointe le lien et c'est pour ça qu'il me demande de le re créer. Si je joue le jeu et que je le re crée et que je relance la routine, la ça va refonctionner pour ce lien la mais pas pour les autres et si je re crée tous les liens, le programme va fonctionner normalement jusqu'à ce que je déplace un fichier de son emplacement, la, comme je l'ai dis, il va détecter que le fichier n'est plus à sa place mais va également le détecter pour les autres alors que ce n'est pas le cas !

Je suis à la rue !

 

[Luki]

Re : Problème avec mon code

Re,

ceci marche chez moi, à apriori, c'était une mauvaise gestion de l'erreur...

Pas besoin de faire quelque chose après une vérif d'erreur!
par contre réactiver le gestionnaire dès que le test est fait.

Sub HypeLink()


Dim c As Range
For Each c In Range("A1:A3")  '[COLOR=DarkOrange] A corriger[/COLOR]
On Error Resume Next
GetAttr c.Hyperlinks(1).Address
Debug.Print Err.Number
If Err.Number <> 0 Then
    MsgBox "Le lien pointant sur le fichier nommé " & c.Value & " est rompu ou le fichier n'est plus dans le même emplacement, cliquez sur OK pour le créer ou le re créer", vbCritical, "Lien invalide - Hydro Plumbing"
    ouvrir = Application.GetOpenFilename(filefilter:="tout,*.*", Title:="Sélection")
    If ouvrir = Faux Then Exit Sub
    With ActiveSheet
        d = ouvrir
        b = c.Address
        a = c.Value
        .Hyperlinks.Add .Range(b), d, TextToDisplay:=a
    End With
End If
On Error GoTo 0
Next c
End Sub

A te lire

 

[Luki]

Re : Problème avec mon code

Fanfan,

j'ai mis un lien dans ton premier fil concernant les liens vers celui ci, tu pourrais changer le titre de ce fil aussi, ce serait plus facile de suivre.

A+

 

[Fanfan68]

Re : Problème avec mon code

Désolé Luki mais ça ne change rien quand même, j'ai toujours le même problème, si je clique sur le lien, j'ouvre le fichier en question mais si je lence le code, il passe dans le Else de ma condidtion.

C'est vraiment un casse-tête !

 

[Luki]

Re : Problème avec mon code

re,

mais si je lence le code, il passe dans le Else de ma condidtion.

Il n'ya pas de "ELSE" dans le code que je te propose!

Alors, zippe un fichier , parce que là, je pense que le pb vient d'ailleurs, impossible à voir pour moi sans le code complet.

A te lire

PS: tu peux enlever la ligne "debug.print err.number", juste là pour faire un test en debuggage.

 

[Fanfan68]

Re : Problème avec mon code

Oupss! vriament désolé Luki, je n'avais pas vu toutes les modifications de ton conde.

désolé également pour la faute dans la phrase "mais si je lence(lance bien sur !) le code, il passe dans le Else de ma condidtion."

Effectivement, je viens de faire un test et ton code semble fonctionner, je te joint tout de même le fichier de manière à ce que tu l'ais sous le coude au cas ou

Je vais d'autres tests et si tu n'as plus de mes nouvelles, c'est que c'est bon.

Merci pour tout.

PS : mon zip fait 125 Ko ???

 

[Fanfan68]

Re : Problème avec mon code

Et aller ! encore des fautes.....

"vriament" -> Vraiment
"Conde" -> code

Et peut-être d'autres que je n'ai vu......

 

[Luki]

Re : Problème avec mon code

Re Fanfan,

Je ne citais pas pour les fautes! mais pour le "ELSE"!!!!!!

Zip 50k max, le tien est trop gros.

Supprime les trucs inutiles si possible.

Je vais d'autres tests et si tu n'as plus de mes nouvelles, c'est que c'est bon.

Tu peux aussi poster en disant : "C'est Ok", comme ça je ne serai pas dans le doute....

Bon courage

 

[Fanfan68]

Re : Problème avec mon code

Re bonjour Luki,

Bon écoutes, ça ne fonctionne pas non plus.

J'ai même changé la philosophie de mon code et je ne passe plus par une gestion d'erreur mais le problème est le même.

Je te joint le fichier, j'ai mis en commentaire le code de l'auto_open pour ne pas qu'il t'ennuie.

Par contre avec ce code, il faut que tu active la référence "Microsoft Scripting Runtime".

Je te rappel mon problème, je crée mes liens, tout va bien, la routine fonctionne, par contre dés que je supprime un lien ou que je déplace un fichier, la procédure passe dans le "Else" ce qui est normal mais elle passe également dans le Else pour les liens qui suivent alors que eux sont bons.

J'espère que tu arriveras à me dépatouiller car j'en peux plus la.

Merci beaucoup

 

[lacorse33]

Re : Problème avec mon code

Bonjour Fanfan68 et le forum,

Par rapport à ton premier message, voici ce qu'il faut mettre dans ton code pour que les liens suivants soient détectés :

Dim c As Range
For Each c In Range("H6:H" & Sheets("Tableau").Range("H65536").End(xlUp).Row
On Error Resume Next
GetAttr c.Hyperlinks(1).Address
If Err.Number = 0 Then
Range("i1").Value = ""
Else
MsgBox "Le lien pointant sur le fichier nommé " & c.Value & " est rompu ou le fichier n'est plus dans le même emplacement, cliquez sur OK pour le créer ou le re créer", vbCritical, "Lien invalide - Hydro Plumbing"
ouvrir = Application.GetOpenFilename(filefilter:="tout,*.*" , Title:="Sélection")
If ouvrir = Faux Then Exit Sub
With ActiveSheet
d = ouvrir
b = c.Address
a = c.Value
.Hyperlinks.Add .Range(b), d, TextToDisplay:=a
End With
End If
'On Error GoTo 0
err.clear
Next c

Je pense que cela doit fonctionner.

Merci
@+
Béa