Macro pour créer liens hypertextes...

Christian0258

XLDnaute Accro
Bonjour à tout le forum,

Je souhaiterais votre aide pour me dire pourquoi cette macro ne fonctionne que partiellement…?

voir fichier joint

Merci pour votre aide si précieuse.

Bien à vous,
Christian
 

Pièces jointes

  • Créer les liens.zip
    3 MB · Affichages: 18

job75

XLDnaute Barbatruc
Bonjour Christian0258,

Le plus simple :
Code:
Sub CreerLiens()
Dim chemin$, c As Range
chemin = ThisWorkbook.Path & "\Dossier PDF\_" 'avec tiret bas
With Sheets("Archives")
    For Each c In Intersect(.Range("P3:P10000"), .UsedRange)
        If c <> "" Then If Dir(chemin & c) <> "" Then .Hyperlinks.Add c(1, 2), chemin & c, TextToDisplay:=c.Text
    Next
End With
End Sub
Mais pourquoi diable avoir mis un tiret bas devant les noms des fichiers PDF ?

Fichier et dossier joints à placer dans le même répertoire.

A+
 

Pièces jointes

  • MacroCréerLienHypertexteDynamiqueV01.zip
    2.9 MB · Affichages: 31

Christian0258

XLDnaute Accro
Re, le forum, job75

A nouveau merci, job75, pour ton code, c'est parfait…

Bien à toi,
Christian

Pour le tiret bas, c'est dû à ce code que je n'ai pas su adapter...lol

Dim LeParcours As String, LeRep As String
LeParcours = Range("AM16").Value
LeRep = ThisWorkbook.Path & "\Dossier PDF\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
LeRep & "_" & LeParcours & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
From:=1, To:=1, OpenAfterPublish:=False
 
Dernière édition:

job75

XLDnaute Barbatruc
Re,

C'est bien ce que je pensais, du travail baclé, au lieu de :
Code:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
LeRep & "_" & LeParcours & ".pdf"
il suffisait d'écrire :
Code:
If LeParcours <> "" Then ActiveSheet.ExportAsFixedFormat xlTypePDF, LeRep & LeParcours
Et si tu as 1000 fichiers PDF avec un tiret tu sauras les renommer j'espère ?

A+
 

Christian0258

XLDnaute Accro
Re, le forum, job75,

Je reviens vers vous car j'ai inséré la correction, de job75 post 4, mais rien n'est enregistré dans "Dossier PDF".
J'ai sûrement mal fait la correction de job75 ?

le code final ;

Dim LeParcours As String, LeRep As String
LeParcours = Range("AM16").Value
LeRep = ThisWorkbook.Path & "\Dossier PDF\"
If LeParcours <> "" Then ActiveSheet.ExportAsFixedFormat xlTypePDF, LeRep & LeParcours, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
From:=1, To:=1, OpenAfterPublish:=False

Merci pour votre aide.

Bien à vous,
Christian
 

Christian0258

XLDnaute Accro
Re, le forum, job75,

OK, merci job75, c'était bien AM16 le problème, du coup dans ta macro pour créer les liens vers "Dossier PDF" il faut enlever le tiret sur cette ligne de commande ???;

chemin = ThisWorkbook.Path & "\Dossier PDF\_" 'avec tiret bas

A vous lire, bien à vous,

Encore merci, job75.

Bien amicalement,
Christian
 

job75

XLDnaute Barbatruc
Re,
c'était bien AM16 le problème, du coup dans ta macro pour créer les liens vers "Dossier PDF" il faut enlever le tiret sur cette ligne de commande ???;

chemin = ThisWorkbook.Path & "\Dossier PDF\_" 'avec tiret bas
Oui bien sûr puisqu'il n'y a plus de tiret.

Cela dit si tu as créé beaucoup de fichiers avec tiret les recréer un par un sera très pénible.

Pour ôter le tiret des fichiers existants tu peux utiliser l'une de ces 2 macros :
Code:
Sub OterTiret1()
Dim chemin$, fichier$
chemin = ThisWorkbook.Path & "\Dossier PDF\"
fichier = Dir(chemin & "_*.pdf") '1er fichier, avec tiret bas
While fichier <> ""
    If fichier <> "_.pdf" Then Name chemin & fichier As chemin & Mid(fichier, 2) 'renomme
    fichier = Dir
Wend
End Sub

Sub OterTiret2()
Dim chemin$, f As Object
chemin = ThisWorkbook.Path & "\Dossier PDF\"
For Each f In CreateObject("Scripting.FileSystemObject").GetFolder(chemin).Files
    If f.Name Like "_?*.pdf" Then Name chemin & f.Name As chemin & Mid(f.Name, 2) 'renomme
Next
End Sub
A+
 

Discussions similaires

Réponses
7
Affichages
436

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 846
dernier inscrit
Silhabib