remplir cellule excel après clique sur un hyperlien

[etien38]

Bonjour à tous,

J'ai sur ma Sheet2 plusieurs hyperliens me renvoyant sur ma Sheet1.

J'aimerai en cliquant sur un hyperlien en copier le contenu texte et le coller dans la cellule cible de l'hyperlien, à savoir la cellule C4 de Sheet1 (la cible est la même quel que soit l'hyperlien).

Est-ce faisable en VBA ?

J'ai essayé avec Workbook_SheetFollowHyperlink() mais étant une bille en VBA je n'obtient pas ce que je désire.

Merci par avance pour vos réponses

 

[vgendron]

Hello
en metttant cette ligne de code dans l'évènement que tu as bien identifié

Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
ActiveCell = Target.Name
End Sub

 

[job75]

Bonjour etien38, vgendron,

Dans le code de Sheet2 (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_FollowHyperlink(ByVal h As Hyperlink)
Sheets("Sheet1").[C4] = h.Parent
End Sub

ou :

Private Sub Worksheet_FollowHyperlink(ByVal h As Hyperlink)
Evaluate(h.SubAddress) = h.Parent
End Sub

A+

 

[etien38]

Bonjour,

Merci pour vos réponses.
Une chose m'échappe, aucune de vos propositions ne marche chez moi.
Je ne voit pas si cela viens du fait que mon Excel est configuré en français avec de ce fait la fonction "Lien_hypertexte" et non "Hyperlink" ou s'il me manquerait un plug-in.
Je peut exclure un problème venant du pare-feu, car je réussi au niveau VBA à afficher des MsgBox et j'autorise les macros Excel au niveau le plus haut.

 

[job75]

Bonjour etien38, vgendron,

Les liens créés à l'aide de la fonction LIEN_HYPERTEXTE ne sont pas de "vrais" liens hypertextes.

Pour transformer vos formules en "vrais" liens exécutez cette macro :

Sub Liens()
Dim c As Range, t$
On Error Resume Next
For Each c In Cells.SpecialCells(xlCellTypeFormulas)
  If c.Formula Like "=HYPERLINK(*)" Then
    t = CStr(c)
    c.Clear 'RAZ
    c.Hyperlinks.Add c, "", "Sheet1!C4", TextToDisplay:=t
  End If
Next
End Sub

Les solutions qu'on vous a données fonctionneront alors.

A+

 

[etien38]

Bonjour job75, vgendron

Effectivement le problème semble venir de ma formule pour le lien hypertexte puisque sans passer par cette dernière cela marche.

J'utilise la formule suivante : =LIEN_HYPERTEXTE("#"&CELLULE("address";Sheet1!$C$4);[@[Risk reference]]) avec @[Riskreference] le nom de la cellule à gauche de mon lien.

Je pense que mon appel avec le @ pour le nom convivial fait tout planter.

Je vais continuer de creuser, en tout cas merci beaucoup.

 

[Si...]

Bon_jour

Une proposition (avec ce que j'ai compris) : dans la fenêtre de code de l'onglet des liens (clic bouton droit sur son nom puis sélectionner Visualiser le code)

Private Sub Worksheet_SelectionChange(ByVal R As Range)
  If R.Hyperlinks Is Nothing Then Feuil1.[C4] = "" Else ActiveCell = R.Text
End Sub

édit : je n'avais pas encore vu ton problème du @

 

[job75]

Re, salut Si...

Votre formule avec [@[Risk reference]] montre que vous utilisez un tableau Excel.

Comme d'évidence une ankylose du poignet vous empêche de joindre votre fichier je mets le mien.

Le code de la feuille "Sheet2" :

Private Sub Worksheet_Change(ByVal r As Range)
Set r = Intersect(r, [Tableau1[Risk reference]]) 'nom du tableau à adapter
If r Is Nothing Then Exit Sub
For Each r In r
  If r <> "" And r.Hyperlinks.Count = 0 Then r.Hyperlinks.Add r, "", "Sheet1!C4"
Next
End Sub

Private Sub Worksheet_FollowHyperlink(ByVal h As Hyperlink)
Sheets("Sheet1").[C4] = h.Parent
End Sub

A+