Lien hypertext selon critères

[stefb44]

Bonjour,

Je suis à la recherche d'une solution pour insérer dans une cellule le lien hypertexte vers un fichier pdf.
Il s'agit d'une sorte de base de donnée incluant l'ensemble des devis que j'ai réalisé pour mes clients.

Le numéro de devis est unique pour chaque client et/ou affaire.

J'ai donc une macro qui fonctionne parfaitement bien même si je ne connais pas le nom complet sous lequel j'ai enregistré mon fichier PDF.
Le problème survient lorsque je modifie un devis, et alors je rajoute à la fin de mon nom de fichier _Ind.A (Si première modif), _Ind.B (si deuxième), etc....

J'ai alors la macro qui prend la première ligne qu'il trouve pour le mettre en lien hypertexte.
Dans mon fichier Excel, j'ai une colonne dans laquelle j'indique la version du devis (Colonne P).

Il ne devrait pas être compliqué de trouver le lien par le biais du début du nom de fichier (Qui commence toujours par le numéro de devis, et qui finit par l'indice [_Ind.A.pdf], mais voila je n'y arrive pas.

Voici la macro que j'utilise :

Sub Liens()
Dim Appli As String

For Each Cel In Range("b5:b" & [b65000].End(xlUp).Row)
Ind = Cel.Offset(0, 14)
Appli = ThisWorkbook.Path & "\OFFRES 2011\"
fich = Appli & Dir(Appli & Cel.Value & "*")

If Ind = "" Then ActiveSheet.Hyperlinks.Add Anchor:=Cel.Offset(0, 1), Address:=fich, TextToDisplay:="voir devis" Else Cel.Offset(0, 1).ClearContents

Next Cel
End Sub

Quelqu'un aurait il une idée à me proposer.
D'avance merci beaucoup.

Cordialement,
Stef

PS. En pièce jointe un etrait de ma base de donnée.

 

[stefb44]

Re : Lien hypertext selon critères

Bonjour à tous,

Personne n'a d'idée pour m'aider dans ma recherche ??
D'avance merci de votre soutien.

Slts,
Stef

 

[francedemo]

Re : Lien hypertext selon critères

bonjour stef
j'ai eu le même soucis, je n'ai rien trouvé pour passer un caractère générique à Hyperlink
je suis donc obligé de faire une mise à jour de chaque lien (je le fais avec une macro) pour que ça marche
ça prends quelques secondes...

à+

 

[stefb44]

Re : Lien hypertext selon critères

Bonjour Francedemo,

Quel type de macro utilisé tu pour faire cela en manuel?
?

Merci.

 

[francedemo]

Re : Lien hypertext selon critères

en fait, j'ai un fichier qui sert de récap aux différents matériels
du coup, je crée un lien qui pointe sur chaque fichier existant
je fais ça avec une boucle
et, à chque changement sur le nom d'un fichier, le lien ne fonctionne plus, d'où la mise à jour répétée...

juste pour le fun :

Option Explicit
Dim Cel As Range
Dim ZoneLien As Range
Dim debut As Long '===debug

Sub AjoutLienSommaire()

Dim CheFichier As String
Dim Fich As String
Dim FSO As Object
Dim NomFich As String
Dim Num As Variant

debut = Timer '===debug

'===mise à jour de l'affichage
With Application
   .ScreenUpdating = False
   .DisplayAlerts = False
   .EnableEvents = False
End With

Set FSO = CreateObject("Scripting.FileSystemObject")
CheFichier = ThisWorkbook.Path & "\"
Fich = Dir(CheFichier & "*.xls")
If Not Fich Like "xxx" Then Fich = Dir
Num = Split(Fich, "_")

Set ZoneLien = Range("A2:A" & [A65536].End(xlUp).Row)

'===suppression des liens existants
With ZoneLien
    .Hyperlinks.Delete
    .Font.Bold = True
    .HorizontalAlignment = xlCenter
    .NumberFormat = "0000"
End With

'===création des liens hypertexte
For Each Cel In ZoneLien
    NomFich = Dir(CheFichier & Num(0) & "_" & Format(Cel.Value, "0000") & "*.xls")
    If FSO.FileExists(CheFichier & NomFich) Then Cel.Hyperlinks.Add _
        anchor:=Cel, _
        Address:=NomFich
    Cel.Font.Bold = True
Next Cel

'==mise à jour de l'affichage
With Application
   .ScreenUpdating = True
   .DisplayAlerts = True
   .EnableEvents = True
End With

MsgBox Timer - debut  '===debug

End Sub

(pour info, je balaie 1500 fichiers sur le réseau en moins 25 s)
je suis obliger de triturer un peu le nom de fichier pour que ma macro soit identique dans tous mes cas de figures (j'en ai 12...)
à+

 

[stefb44]

Re : Lien hypertext selon critères

Bonsoir,

J'ai finalement trouvé une solution aujourd'hui tout seul.
J'ai modifié ma macro de lien de la façon suivante, et cela marche parfaitement.

Merci quand même.

Macro :

Sub Liens()
Dim Appli As String
Dim lg As String
Dim lg2 As String

For Each Cel In Range("b5:b" & [b65000].End(xlUp).Row)
Ind = Cel.Offset(0, 14)
Appli = ThisWorkbook.Path & "\OFFRES 2011\"
Fich = Appli & Dir(Appli & Cel.Value & "*")
lg = Len(Fich)
Fich2 = Left(Fich, lg - 4)
Fich3 = Fich2 & "_Ind." & Ind & ".pdf"
lg2 = Len(Fich3)
Cel.Offset(0, 48).Value = lg2


If Ind = "" Then ActiveSheet.Hyperlinks.Add Anchor:=Cel.Offset(0, 1), Address:=Fich, TextToDisplay:="voir devis" Else ActiveSheet.Hyperlinks.Add Anchor:=Cel.Offset(0, 1), Address:=Fich3, TextToDisplay:="voir devis"
If lg2 < 85 Then Cel.Offset(0, 1).Value = "Erreur"

Next Cel

End Sub

Bonne soirée à tous.
Stef