1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
| Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim cell As Range
Dim folderPath As String
Dim hyperlinkAddress As String
Dim oldName As String
' Spécifiez la plage de la colonne où se trouvent les valeurs
Set rng = Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row)
' Spécifiez le chemin du répertoire où les dossiers sont créés
folderPath = "C:\Users\sabine.luesma\Desktop\test dpec\"
' Vérifiez si la modification a été apportée dans la plage spécifiée
If Not Intersect(Target, rng) Is Nothing Then
' Parcourez chaque cellule modifiée
For Each cell In Intersect(Target, rng)
' Vérifiez si la cellule n'est pas vide
If cell.Value <> "" Then
' Mettez à jour le nom du dossier avec la nouvelle valeur de la cellule
oldName = cell.Value ' Vous devez définir l'ancien nom avant de le changer
Name folderPath & oldName As folderPath & cell.Value
' Mettez à jour l'adresse du lien hypertexte avec le nouveau nom de dossier
hyperlinkAddress = folderPath & cell.Value & "\"
cell.Hyperlinks.Add Anchor:=cell, Address:=hyperlinkAddress, TextToDisplay:=cell.Value
End If
Next cell
End If
End Sub |
Partager