XL 2019 Incrémentation lien hypertexte dans image sans lecteur drive

farid · 21 Septembre 2021

Bonjour, lorsque je clic sur le bouton TEST, j'ouvre bien le dossier selon le choix de la cellule B3 et lorsque le dossier est ouvert, je clic sur le fichier choisi, Après ce choix, l'image ImagePourleLien qui se trouve dans la feuille PARAM vient se coller dans la cellule J19 avec incrémentation du chemin du fichier.

La question est :

Est-ce possible lors de la création du lien dans l'image ImagePourleLien , que le chemin du lien hypertexte soit écrit sans lettre drive afin que je puisse ouvrir le fichier sur n'importe quelle lettre drive,

Mes fichiers sont stockés sur un disque amovible et donc cela arrive qu’il change de lettre selon les PC sur lequel il est connecté mais aussi avec impossibilité de changer la lettre du lecteur du fait que je ne possède pas les droits administrateurs.

Dans l’exemple du fichier joint, le fichier schap a été crée avec la lettre du drive F:\, et lorsque je connecte mon drive sur un autre PC, impossible de l’ouvrir sur une autre lettre de lecteur.

J’espère être clair dans ma demande.

Merci , par avance .

Dranreb · 26 Septembre 2021

Bonjour.
Comme ça :

VB:

Private Sub Workbook_Open()
   Dim Lec As String, Wsh As Worksheet, Hyp As Hyperlink
   Lec = Left$(Me.Path, 1)
   For Each Wsh In Me.Worksheets
      For Each Hyp In Wsh.Hyperlinks
         Hyp.Address = Lec & Mid$(Hyp.Address, 2)
         Next Hyp, Wsh
   End Sub

Dranreb · 22 Septembre 2021

Bonsoir.
Essayez ça dans un module standard :

VB:

Sub Test()
   Dim Lec As String, Hyp As Hyperlink
   Lec = Left$(ThisWorkbook.Path, 1)
   For Each Hyp In ActiveSheet.Hyperlinks
      Hyp.Address = Lec & Mid$(Hyp.Address, 2)
      Next Hyp
   End Sub

Si ça marche bien faites en une Private Sub Workbook_Open dans le module ThisWorkbook, où d'ailleurs ThisWorkbook peut y être remplacé par Me, mais là seulement. Vous pouvez encore le faire pour toutes les feuilles s'il y a lieu en englobant tout ça par un For Each Wsh In Me.Worksheets et en remplaçant dans la boucle interne Activesheet par Wsh, déclaré bien sûr As Worksheet.

farid · 26 Septembre 2021

Dranreb à dit:
Bonsoir.
Essayez ça dans un module standard :

VB:

Sub Test() Dim Lec As String, Hyp As Hyperlink Lec = Left$(ThisWorkbook.Path, 1) For Each Hyp In ActiveSheet.Hyperlinks Hyp.Address = Lec & Mid$(Hyp.Address, 2) Next Hyp End Sub

Si ça marche bien faites en une Private Sub Workbook_Open dans le module ThisWorkbook, où d'ailleurs ThisWorkbook peut y être remplacé par Me, mais là seulement. Vous pouvez encore le faire pour toutes les feuilles s'il y a lieu en englobant tout ça par un For Each Wsh In Me.Worksheets et en remplaçant dans la boucle interne Activesheet par Wsh, déclaré bien sûr As Worksheet.

Bonjour Dranreb
merci beaucoup pour ce retour et la premiere partie focntionne tres bien par un bouton.
par contre la partie :
Vous pouvez encore le faire pour toutes les feuilles s'il y a lieu en englobant tout ça par un For Each Wsh In Me.Worksheets et en remplaçant dans la boucle interne Activesheet par Wsh, déclaré bien sûr As Worksheet.

effectivement le une Private Sub Workbook_Open fonctionne bien automatiquement sur la feuille a son ouverture mais pas sur les autres feuilles comme dans le l'exemple en Pj. cette partie , je bug , serait possible de pouvoir me le détailler en un exemple afin que je puisse saisir votre idée. Pour info , sur le fichier source , j'ai plusieurs feuilles .
merci , par avance

Dranreb · 26 Septembre 2021

Bonjour.
Comme ça :

VB:

Private Sub Workbook_Open()
   Dim Lec As String, Wsh As Worksheet, Hyp As Hyperlink
   Lec = Left$(Me.Path, 1)
   For Each Wsh In Me.Worksheets
      For Each Hyp In Wsh.Hyperlinks
         Hyp.Address = Lec & Mid$(Hyp.Address, 2)
         Next Hyp, Wsh
   End Sub

farid · 26 Septembre 2021

Dranreb à dit:

Bonjour.
Comme ça :

VB:

Private Sub Workbook_Open()
   Dim Lec As String, Wsh As Worksheet, Hyp As Hyperlink
   Lec = Left$(Me.Path, 1)
   For Each Wsh In Me.Worksheets
      For Each Hyp In Wsh.Hyperlinks
         Hyp.Address = Lec & Mid$(Hyp.Address, 2)
         Next Hyp, Wsh
   End Sub

Bonsoir Dranreb,
merci infiniment pour ce retour rapide et qui fonctionne très bien. Vous m'avez extrait une épine du pied.
bien cordialement
au plaisir

XL 2019 Incrémentation lien hypertexte dans image sans lecteur drive

farid

XLDnaute Occasionnel

Pièces jointes

Dranreb

Dranreb

XLDnaute Barbatruc

farid

XLDnaute Occasionnel

Pièces jointes

Dranreb

XLDnaute Barbatruc

farid

XLDnaute Occasionnel

Discussions similaires