Macro lien hypertexte direct vers un répertoire précis
Bonjour,
Mon ordinateur a été remplacé et j'ai malheureusement oublié de récupérer une macro qu'on m'avait fait pour gagner du temps.
Cette macro, que j'avais mis en raccourci dans le ruban, me permettait d'atteindre un répertoire bien précis dans lequel je pouvais choisir un sous-répertoire à mettre en lien hypertexte dans un fichier excel.
Aujourd'hui j'ai retrouvé cette macro que j'ai enregistré sans la modifier mais lorsque je l'exécute elle n'ouvre pas le répertoire souhaité.
voici la macro :
Public Sub Hyperlien_HA()
Dim strFichier As String
Dim strReper As String
'Changer ici pour le bon nom de répertoire:
strReper = "\\srvservices\Service Achats\"
'Ouvre une fenêtre pour rechercher le fichier à mettre en hyperlien
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.InitialView = msoFileDialogViewDetails
.InitialFileName = strReper
.Title = "Choisissez le document vers lequel faire un lien."
If .Show <> 0 Then
strFichier = .SelectedItems(1)
Else
Exit Sub
End If
End With
ActiveWorkbook.ActiveSheet.Hyperlinks.Add ActiveSheet.Range(ActiveCell.Address), strFichier
End Sub
En effet en cliquant sur la macro j'arrivai directement dans le répertoire indiqué \\srvservices\Service Achats\ aujourd'hui j'arrive directement dans le répertoire Bibliothèques\Documents.
Faut-il enregistrer la macro dans un répertoire bien précis ? Ou y a-t-il une erreur dans le code ? (pourtant elle fonctionnait comme ça avant).
Je n'y connais pas grand chose en VBA et j'espère avoir été claire dans mon explication.
Si vous pouvez m'aider cela me rendrai un grand service.
Je viens de m'apercevoir que non seulement la macro ne m'ouvre pas le bon répertoire directement mais en plus même si je sélectionne le bon répertoire, le lien hypertexte ne se fait pas.
Hello,
Alors, alors par quoi commencer, que dire... hummm...
Voici la solution, pour l'adaptation :
1/ Chemin d'accès complet impératif :
'Changer ici pour le bon nom de répertoire:
strReper = "\\srvservices\Service Achats\" "C:\Users\Wakanae\srvservices\Service Achats"
J'ai un lien hypertexte, du dossier choisit
2/ Lieu du lien hypertexte :
ActiveCell.Address => Il colle le lien là où se trouvait la dernière cellule sélectionnée, tu peux remplacé cette adresse par adresse cellule "A1" par exemple.
ActiveSheet => C'est la feuille active, tu peux modifier par worksheets(1), pour feuille 1.
ActiveWorkbook => C'est le classeur actif, je pense que si par hasard tu clic sur une autre fenêtre tu risque de trouver ton lien sur un autre classeur, tu peux remplacer par thisworkbook
Et voilà,
Public Sub Hyperlien_HA()
Dim strFichier As String
Dim strReper As String
'Changer ici pour le bon nom de répertoire:
strReper = "C:\Users\waard\DOCS"
'Ouvre une fenêtre pour rechercher le fichier à mettre en hyperlien
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.InitialView = msoFileDialogViewDetails
.InitialFileName = strReper
.Title = "Choisissez le document vers lequel faire un lien."
If .Show <> 0 Then
strFichier = .SelectedItems(1)
Else
Exit Sub
End If
End With
ThisWorkbook.Worksheets(1).Hyperlinks.Add Worksheets(1).Range("C12"), strFichier
End SubMerci pour ce retour,
je teste dès cet après-midi et je te tien au courant.
Bonjour,
Merci beaucoup, tout refonctionne !
Bonjour à tous, je me permet de "déterrer" ce sujet,
Je ne connais absolument rien en VBA donc quand je cherche quelque chose je copie et colle et test deux trois choses.
Bref, j'ai trouvé ce code qui fonctionne chez moi mais aucun fichier n'apparaît dans ma boite de dialogue donc pas de lien Hypertexte du coup.
C'est un fichier DOC tout bête.
Je remet le code au cas où.
Public Sub Hyperlien_HA()
Dim strFichier As String
Dim strReper As String
'Changer ici pour le bon nom de répertoire:
strReper = "G:\ENEDIS_AGENCE_DINTERVENTION_BEX_SILLON_RHODA\BEX\15-Accident"
'Ouvre une fenêtre pour rechercher le fichier à mettre en hyperlien
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.InitialView = msoFileDialogViewDetails
.InitialFileName = strReper
.Title = "Choisissez le document vers lequel faire un lien."
If .Show <> 0 Then
strFichier = .SelectedItems(1)
Else
Exit Sub
End If
End With
ThisWorkbook.Worksheets(1).Hyperlinks.Add Worksheets(1).Range("ActiveCell"), strFichier
End Sub
Merci de vos réponses.