Ouvrir plusieurs liens hypertextes dynamiques
Bonjour à tous,
Après plusieurs recherches infructueuses, je vous soumets mon problème.
J'ai un fichier qui va chercher des données dans plusieurs fichiers. Le truc, c'est que leurs chemins d'accès et leurs noms changent tous les mois. Du coup, j'ai créé des liens hypertextes dynamiques de ce style :
=LIEN_HYPERTEXTE("\\SERVEUR\Répertoire1\Réel "&DROITE(J1;2)&"\"&TEXTE(J2;"00")&"blabla.xls";"Source à ouvrir")
Les cellules J1 et J2 font référence à l'année et au mois en-cours.
Les cellules qui vont piocher dans les fichiers source ressemblent à ceci :
=INDIRECT("'\\SERVEUR\Répertoire1\Réel "&DROITE(J1;2)&"\["&TEXTE(J2;"00")&"blabla.xls]Nom_onglet'!T46";VRAI)
J'ai 6 liens (pour le moment) comme celui-là à cliquer pour que tous les liens fonctionnent, sinon j'ai les fameux #REF!.
Au final, je souhaiterai savoir s'il existe un moyen pour ouvrir mes 6 liens hypertextes dynamiques.
Merci beaucoup.
(Excel 2010)
Bonjour,
un essai en passant par une macro événementielle cliquer sur la cellule A1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
Selection.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"\\SERVEUR\Répertoire1\Réel " & Right(Range("J1"), 2) & "\" & Format(Range("J2"), "00") & "blabla.xls", TextToDisplay:="Source à ouvrir"
Range("A1").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
End Sub
J'ai essayé de remplacer la partie \\SERVEUR par la vraie formule de mon fichier mais la ligne se met en rouge dans Visual Basic.
Pour info, voici la vraie formule utilisée pour une source :
=LIEN_HYPERTEXTE("\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY"&DROITE(J1;2)&"\"&TEXTE(J2;"00")&" FY"&DROITE(J1;2)&"\Reporting package NOM "&TEXTE(J2;"00")&".FY"&DROITE(J1;2)&".xls";"Source NOM A à ouvrir")
J'ai essayé dans une formule non dynamique mais cliquez en A1 ne fait rien.
Merci.
bonjour,
essaie ceci pour A1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
Selection.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & rigth(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & rigth(Range("j1"), 2) & "\Reporting package NOM "_
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls", TextToDisplay:="Source à ouvrir"
Range("A1").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
End Sub
rebonjou,r
correction
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
Selection.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & rigth(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & rigth(Range("j1"), 2) & "\Reporting package NOM " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls", TextToDisplay:="Source à ouvrir"
Range("A1").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
End Sub
Re-bonjour et re-merci
J'ai un nouveau message d'erreur :
Erreur de compilation
Sub ou Function non définie
La première ligne est surlignée en jaune.
désolé,
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
Selection.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & Right(Range("j1"), 2) & "\Reporting package NOM " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls", TextToDisplay:="Source à ouvrir"
Range("A1").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
End Sub
Pas de soucis.
Le fait de cliquer sur A1 lance la macro maintenant.
Erreur d'exécution '-2147221014 (800401ea)':
Impossible d'ouvrir le fichier spécifié
Après avoir cliqué sur Débogage, cette partie de la macro est surlignée en jaune :
Range("A1").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
c'est que le fichier n'existe pas ou que le nom n'est pas correct.
j'ai modifié la macro pour qu'elle affiche le nom du lien qu'elle va ouvrir.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
nf = "\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & Right(Range("j1"), 2) & "\Reporting package NOM " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls"
MsgBox "ouverture du fichier " & nf
Selection.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=nf, TextToDisplay:="Source à ouvrir"
Range("A1").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Selection.Hyperlinks.Delete
End Sub
Pratique
En fait, la macro donne :
\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY15\0215\Reporting package NOM 02.FY15.xls
Au lieu de :
\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY15\02 FY15\Reporting package NOM 02.FY15.xls
J'aurais bien fait la correction moi-même mais je ne connais rien en VBA... Merci.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
' \\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY15\02 FY15\Reporting package NOM 02.FY15.xls
nf = "\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & " FY" & Right(Range("j1"), 2) & "\Reporting package NOM " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls"
MsgBox "ouverture du fichier " & nf
Selection.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=nf, TextToDisplay:="Source à ouvrir"
Range("A1").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
End Sub
Excellent, ça marche !
Reste plusieurs qu'à intégrer les 5 autres liens
Où est-ce que je positionne ces liens ? Je peux mettre plusieurs "nf =" à la suite ?
voici comment je ferais, pour des liens qui iraient de A1 à A6, à toi de mettre le nf qui va bien.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 1 Or Target.Row > 6 Then Exit Sub
Select Case Target.Address
Case "$A$1"
nf = "\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & " FY" & Right(Range("j1"), 2) & "\Reporting package NOM " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls"
Case "$A$2"
nf = "\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & " FY" & Right(Range("j1"), 2) & "\Reporting package NOM " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls"
Case "$A$3"
nf = "\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & " FY" & Right(Range("j1"), 2) & "\Reporting package NOM " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls"
Case "$A$4"
nf = "\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & " FY" & Right(Range("j1"), 2) & "\Reporting package NOM " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls"
Case "$A$5"
nf = "\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & " FY" & Right(Range("j1"), 2) & "\Reporting package NOM " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls"
Case "$A$6"
nf = "\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & " FY" & Right(Range("j1"), 2) & "\Reporting package NOM " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls"
End Select
MsgBox "ouverture du fichier " & nf
Selection.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=nf, TextToDisplay:="Source à ouvrir"
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Selection.Hyperlinks.Delete
End Sub
Donc il faudrait que je clique de A1 à A6 pour ouvrir tous les fichiers ? Car c'est déjà ce que je fais sans macro. Le but est bien de réduire ce temps d'ouverture de fichiers source. Cliquer sur A1 pour ouvrir 6 fichiers source.
primokorn a écrit :Donc il faudrait que je clique de A1 à A6 pour ouvrir tous les fichiers ? Car c'est déjà ce que je fais sans macro. Le but est bien de réduire ce temps d'ouverture de fichiers source. Cliquer sur A1 pour ouvrir 6 fichiers source.
je n'avais pas compris
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 1 Or Target.Row > 6 Then Exit Sub
Range("a1").Select
nf = "\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & " FY" & Right(Range("j1"), 2) & "\Reporting package NOM " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls"
Selection.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=nf, TextToDisplay:="Source à ouvrir"
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Selection.Hyperlinks.Delete
Range("a1").Select
nf = "\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & " FY" & Right(Range("j1"), 2) & "\Reporting package NOM " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls"
Selection.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=nf, TextToDisplay:="Source à ouvrir"
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Selection.Hyperlinks.Delete
Range("a1").Select
nf = "\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & " FY" & Right(Range("j1"), 2) & "\Reporting package NOM " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls"
Selection.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=nf, TextToDisplay:="Source à ouvrir"
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Selection.Hyperlinks.Delete
Range("a1").Select
nf = "\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & " FY" & Right(Range("j1"), 2) & "\Reporting package NOM " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls"
Selection.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=nf, TextToDisplay:="Source à ouvrir"
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Selection.Hyperlinks.Delete
Range("a1").Select
nf = "\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & " FY" & Right(Range("j1"), 2) & "\Reporting package NOM " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls"
Selection.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=nf, TextToDisplay:="Source à ouvrir"
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Selection.Hyperlinks.Delete
Range("a1").Select
nf = "\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & " FY" & Right(Range("j1"), 2) & "\Reporting package NOM " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls"
Selection.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=nf, TextToDisplay:="Source à ouvrir"
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Selection.Hyperlinks.Delete
End Sub
Cool, je teste ça au plus vite.
A plus tard pour le retour, merci encore.
Bonjour,
J'ai testé en prenant deux liens dynamiques pour commencer :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 1 Or Target.Row > 6 Then Exit Sub
Range("a1").Select
nf = "\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & " FY" & Right(Range("j1"), 2) & "\Reporting package NOM1 " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls"
Selection.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=nf, TextToDisplay:="Source à ouvrir"
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Selection.Hyperlinks.Delete
Range("a1").Select
nf = "\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & " FY" & Right(Range("j1"), 2) & "\Reporting package NOM2 " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xlsx"
Selection.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=nf, TextToDisplay:="Source à ouvrir"
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Selection.Hyperlinks.Delete
End Sub
Le premier lien s'ouvre toujours bien mais j'ai un message d'erreur pour le second (qui ne s'ouvre pas) :
Erreur d'exécution '1004':
La méthode Select de la classe Range a échoué.
Le débogage surligne en jaune le 2e Range("a1").Select
Merci.
bonjour,
enlève cette instruction, je l'ai laissée par erreur
Bonjour,
Nouveau cas
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 1 Or Target.Row > 6 Then Exit Sub
Range("a1").Select
nf = "\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & " FY" & Right(Range("j1"), 2) & "\Reporting package NOM1 " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xls"
Selection.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=nf, TextToDisplay:="Source à ouvrir"
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Selection.Hyperlinks.Delete
nf = "\\ACB0SR40\Daf\40_Filiales\Reporting Mensuel\8 pages\Réel FY" & Right(Range("j1"), 2) & "\" & _
Format(Range("J2"), "00") & " FY" & Right(Range("j1"), 2) & "\Reporting package NOM2 " _
& Format(Range("J2"), "00") & ".FY" & _
Right(Range("J1"), 2) & ".xlsx"
Selection.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=nf, TextToDisplay:="Source à ouvrir"
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Selection.Hyperlinks.Delete
End Sub
Je clique sur A1 :
• Le fichier NOM1 s'ouvre bien comme avant
• Ensuite, j'ai une popup disant :
Ouverture de \\ACB0SR40\Daf\40_Filiales\...Reporting package NOM2.xlsx
Certains fichiers peuvent contaminer ou endommager votre ordinateur.
Il est important de s'assurer que ce fichier provient d'une source sûre.
Voulez-vous ouvrir ce fichier ?
Je clique sur OK.
Excel se met à mouliner pendant plusieurs minutes puis ouvre Visual basic avec cette popup :
Erreur d'exécution '1004':
La cellule ou le graphique est protégé et en lecture seule.
Pour modifier une cellule ou un graphique protégé, ôtez la protection avec la commande Ôter la protection de la feuille (onglet Révision, groupe Modification). Vous devriez peut-être taper un mot de passe.
Après avoir cliqué sur Débogage, cette ligne est surlignée en jaune :
Selection.Hyperlinks.Delete
Note : il n'y a ni mot de passe ni protection activés dans le fichier source NOM2.