Bonjour Truc33, Le Forum,
Ci-dessous exemple fait de liens d'une feuille 1 vers des cellules cibles de la feuille 2 du même classeur. Pour tester la procédure.
A adapter selon commentaires laissés et besoins propres. Chemins et fichiers personnels.
Première macro dans la partie code de la feuille comportant les liens.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Le double clic sur la colonne à droite (soit En Cours, soit Terminé) d'un lien Hypertexte déjà placé modifie ce lien.
'Et permet de cibler une autre cellule de la feuille 2. Le test est à réaliser de la feuille 1 qui contient le lien vers feuille 2.
'Puis ensuite à modifier et à adapter pour un chemin de lien différent
'Ici "A5" est indiqué à la place du répertoire Downloads
'et "D5" à la place du répertoire Pictures. "H5" à la place du répertoire Music. Voir ensuite la macro Deplace
Dim Str As String
'La colonne En Cours est la colonne J soit 10, la colonne Terminé est K soit 11
'La colonne H, soit 8 contient le nom du fichier et la colonne 9 l'Hyperlien
Select Case Target.Column
Case 10 'Ou tout autre colonne d'En Cours
If Target.Offset(, -1).Hyperlinks.Count = 1 Then Str = Target.Offset(, -1).Hyperlinks(1).SubAddress
Target.Offset(, -1).Hyperlinks(1).SubAddress = Replace(Str, "A5", "D5")
Range(Target.Offset(, -1).Address, Target.Address).Merge
Application.EnableEvents = False
ActiveCell.Offset(, -1).Interior.Color = vbYellow
ActiveCell.Offset(, -1).HorizontalAlignment = xlCenter
Application.EnableEvents = True
ActiveCell.Offset(, -2).Select
'Changement de répertoire par le Call Deplace(N°)
'Ôter le commentaire du Call lorsque les "A5", "D5" et "H5" seront remplacés par les bons répertoires
'Call Deplace(1)
Case 11 'Ou tout autre colonne Terminé
If Target.Offset(, -2).Hyperlinks.Count = 1 Then Str = Target.Offset(, -2).Hyperlinks(1).SubAddress
Target.Offset(, -2).Hyperlinks(1).SubAddress = Replace(Str, "D5", "H5")
Range(Target.Offset(, -2).Address, Target.Address).Merge
Application.EnableEvents = False
ActiveCell.Offset(, -2).Interior.Color = vbGreen
ActiveCell.Offset(, -2).HorizontalAlignment = xlCenter
Application.EnableEvents = True
ActiveCell.Offset(, -3).Select
'Changement de répertoire par le Call Deplace(N°)
'Ôter le commentaire du Call lorsque les "A5", "D5" et "H5" seront remplacés par les bons répertoires
'Call Deplace(2)
End Select
End Sub
Deuxième macro en partie module. Afin de déplacer le fichier. Evidemment celui-ci ne doit pas être ouvert, lors du double-clic.
Sub Deplace(F As Integer)
'Selon l'emplacement actuel du fichier (cas 1 ou 2) le fichier sera déplacé sur le répertoire destiné
'Donc ici pour exemple de Downloads à Pictures (cas En cours)puis ensuite de Pictures à Music (cas Terminé)
Set fs = CreateObject("scripting.FileSystemObject")
Fich = ActiveCell.Value
Cible = IIf(F = 1, "C:\Users\Untel\Downloads\" & Fich, "C:\Users\Untel\Pictures\" & Fich)
If Dir(Cible) > "" Then
Choix = IIf(F = 1, "C:\Users\Untel\Pictures\" & Fich, "C:\Users\Untel\Music\" & Fich)
Set oFile = fs.GetFile(Cible)
oFile.Move Choix
Else: MsgBox "Fichier non trouvé", vbCritical
End If
End Sub
Ci dessous image présentant les trois liens selon les Hypothèses. Le texte SuivreCeFichier (textToDisplay) du lien à personnaliser.