Résolu! Excel-Macro de création de liens hypertexte en automatique

Résolu! Excel-Macro de création de liens hypertexte en automatique - Logiciels - Windows & Software

Marsh Posté le 12-08-2008 à 11:36:12    

Salut à tous. Je deviens dingue :pfff:  
Mon excel comporte un code en colonne P. J'aimerai qu'en colonne T, un lien hypertexte soit généré automatiquement pour pointer un fichier qui porte pour nom le code en colonne P en extension .jpg.
Je ne m'y connais absomument pas ni en macro ni en vba. En fait c'est un peu au dessus de mes forces mais j'ai tellement envie que ça marche!! J'ai essayé plusieurs code et suis tombé sur celui là qui me semble approprié::
 
Sub CreationLiens()
Dim r As Long, i As Long
Dim Fichier As String
Const Dossier As String = "\\Srvfs101\p_vues_eclatées\Photos produits par code article\"
 
    r = Range("P65000" ).End(xlUp).Row
    Columns("T:T" ).Clear
    For i = 3 To r
        Fichier = Dossier & Range("P" & i) & ".xls"
        If Len(Dir(Fichier, vbNormal)) > 0 Then
            ActiveSheet.Hyperlinks.Add Anchor:=Range("T" & i), Address:=Dossier & Range("P" & i) & ".xls", TextToDisplay:=CStr(Range("P" & i))
        Else
            Range("T" & i) = ""
        End If
        Dir ("" )
    Next
End Sub
 
...sauf que ça ne fonctionne pas. Il a l'air sympa pourtant ce vba.
Je serai heureux (et je pèse mes mots) de recevoir de l'aide. Je galère à fouiller, à essayer, à modifier!!!
Merciiiiiiiiiiiiiiiiii


Message édité par larnodestras le 14-08-2008 à 16:36:04
Reply

Marsh Posté le 12-08-2008 à 11:36:12   

Reply

Marsh Posté le 13-08-2008 à 07:58:54    

Bonjour,
j'ai testé et cela fonctionne dans les conditions prévues par le code.  Lorsque tu écris cela ne fonctionne pas, qu'entends-tu par là??
 
As-tu fait un pas à pas de ton vba pour voir à quel niveau l'une des données était incompatible?
 
 
Cordialement


Message édité par seniorpapou le 13-08-2008 à 07:59:53
Reply

Marsh Posté le 13-08-2008 à 11:58:18    

Bonjour!
Bon, j'ai déjà remarqué que j'étais un âne parce que mes fichiers sont en .jpg. J'ai donc modifié les .xls du code en .jpg...mais ça ne fonctionne tout de même pas.  
Ca travaille (longtemps même) mais il n'y a rien dans la colonne T, aucun lien de fait. ?? Tu as obtenu un lien dans la colonne T?

Reply

Marsh Posté le 13-08-2008 à 12:14:58    

bonjour,
oui j'ai obtenu les liens, j'avais même mis un jpg et en cliquant j'obtiens l'image.
 
regarde si ton dossier est bien défini (qu'as-tu écrit dans la ligne const dossier as......)
regarde si dans la colonne P, à partir de la ligne 3, tu as bien les noms de tes images sans le jpg).


Message édité par seniorpapou le 13-08-2008 à 12:15:56
Reply

Marsh Posté le 13-08-2008 à 13:34:22    

Le chemin est bon mais par contre, tous les codes de la colonne P n'ont pas leur image en jpg. Le problème peut venir de là? Au pire, le lien devrait être fait sans qu'on puisse ouvrir d'image. Non?
Qu'as tu obtenu dans la colonne T? Un texte est afficheé?
Merci déjà pour de ton aide!

Reply

Marsh Posté le 13-08-2008 à 14:30:51    

en colonne T j'obtiens le lien.
 
 
Pour positionner le lien dans la colonne T, le code vérifie la présence du fichier par l'instruction:
 
If Len(Dir(Fichier, vbNormal)) > 0 Then  
 
 
donc si le fichier est mal défini (dossier et nom) la mise en place du lien ne se fait pas.
 
tu peux mettre un quote devant les 4 lignes:
If...
else...
range...
 end if
 
comme cela tu verras si l'erreur vient de là
Cordialement
 
 
as-tu essayé d'exécuter ta macro ligne par ligne?


Message édité par seniorpapou le 13-08-2008 à 14:33:10
Reply

Marsh Posté le 14-08-2008 à 10:12:16    

Bonjour,
En procédant comme ça:
Sub CreationLiens()
Dim Lien
Selection.End(xlDown).Select
fin = Selection.Row
For i = 3 To fin
Dim Fichier As String
Const Dossier As String = "\\Srvfs101\p_vues_eclatées\Photos produits par code article\"
r = Range("P65000" ).End(xlUp).Row
Columns("T:T" ).Clear
        Fichier = Dossier & Range("P" & i) & ".jpg"
        'If Len(Dir(Fichier, vbNormal)) > 0 Then
            ActiveSheet.Hyperlinks.Add Anchor:=Range("T" & i), Address:=Dossier & Range("P" & i) & ".jpg", TextToDisplay:=CStr(Range("P" & i))
        'Else
            'Range("T" & i) = ""
        'End If
        Dir ("" )
    Next
End Sub
 
Un lien est fait en ligne 1887 (pourquoi celle là!). Un seul sur 2000 lignes.
Pourtant le chemin est bon, des fichiers sont là mais comme dit, tous les codes n'ont pas leur fichier correspondant.
En pas à pas, je ne vois pas à quelle étape correspond l'action. Je ne m'y connais pas du tout :-(
...c'est frustrant! Un lien est là, pas les autres. On doit être tout prêt.
Merci encore, tu m'apprends plein de trucs!

Reply

Marsh Posté le 14-08-2008 à 12:11:25    

Bonjour,
peux-tu envoyer ton fichier (en modèle réduit, quelques lignes suffiront) sur cjoint. S'il est trop grand je te passerai mon adresse mail et tu mettras en pj.
As-tu mis ton code dans un module où dans feuil1?
 
JE VIENS DE VOIR un columns(T:T).clear!!!!! très mal placé, puisqu'il est dans ta boucle, donc tu effaces  la colonne T à chaque fois.
 
Cette ligne n'était pas à cet endroit sur ton premier post.

 
Remets le " for i= 3 to fin" à sa place et ce sera mieux


Message édité par seniorpapou le 14-08-2008 à 12:18:18
Reply

Marsh Posté le 14-08-2008 à 15:38:14    

Ca y est!! Tous les liens sont là! Merci 1000 fois!!!! Je suis trop content.
C'est effectivement ce clear qui était mal placé à force de bidouiller.
Est ce que tu penses qu'il y a une astuce pour ne pas qu'il affiche de texte dans la colonne T s'il n'y a pas de photo?
 
 
En tout cas, voilà ce que ca donne au final pour d'autres qui pourraient en avoir besoin:
 
Sub CreationLiens()
Dim Lien
Selection.End(xlDown).Select
fin = Selection.Row
Dim Fichier As String
Const Dossier As String = "\\CHEMIN D'ACCES\"
r = Range("P65000" ).End(xlUp).Row
Columns("T:T" ).Clear
For i = 3 To fin
        Fichier = Dossier & Range("P" & i) & ".jpg"
        'If Len(Dir(Fichier, vbNormal)) > 0 Then
            ActiveSheet.Hyperlinks.Add Anchor:=Range("T" & i), Address:=Dossier & Range("P" & i) & ".jpg", TextToDisplay:=CStr(Range("P" & i))
        'Else
            'Range("T" & i) = ""
        'End If
        Dir ("" )
    Next
End Sub
 
A bientot.

Reply

Marsh Posté le 14-08-2008 à 15:44:04    

bonsoir,
tu retires les quotes sur les 4 lignes

Reply

Marsh Posté le 14-08-2008 à 15:44:04   

Reply

Marsh Posté le 14-08-2008 à 16:15:30    

...ben oui.
Tu vois quand je disais que je ne comprenais pas grand chose.
Merci pour ta patience. Je n'y serais jamais arrivé sans ton intervention. Merci merci merci.
A bientot

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed