XL 2016 Insérer lien hypertexte d'une feuille vers une autre créée par macro

[Samtchevsky]

Bonjour à tous,

J'ai un fichier qui me permet de faire un inventaire des équipements techniques d'un bâtiment.
Je rempli le tableau dans la feuille "Equipement" et à l'aide d'une macro je crée automatiquement de nouvelle feuille correspondant aux équipements les plus important. Une seconde macro me permet d'insérer une photo que j'ai renommé au même titre que dans la colonne A de l'équipement concerné.

Je souhaiterais que le texte (ou la cellule) de la colonne A dans le tableau de la feuille "Equipement" devienne un lien hypertexte vers la feuille créée de son équipement.
Vous trouverez le fichier en PJ.

Je vous remercie d'avance pour vos retours.

Amicalement.

 

[job75]

Bonjour Samtchevsky,

Placez dans la macro du bouton, avant Call AffImage :

                    FL1.Hyperlinks.Add FL1.Cells(NoLig, 1), "", "'" & NoLimitcar & "'!C14" 'lien hypertexte

A+

 

[Samtchevsky]

Bonsoir Job75,

Merci beaucoup ça fonctionne super bien.
Je me permets d'abuser.
Seriez-vous quelle modification je dois faire pour placer l'image centrée la cellule D14 de la feuille "Fiche équipement" en ayant pour hauteur maximum la taille de la ligne 14 et garder la proportion sur la largeur?

Merci.

 

[job75]

'sélectionner l'image
With Selection
    .ShapeRange.LockAspectRatio = msoTrue 'conserve les proportions
    .Height = [D14].Height
    .Left = [D14].Left + ([D14].MergeArea.Width - .Width) / 2
    .Top = [D14].Top
End With

 

[Samtchevsky]

Re-bonsoir,

Je suis désolé mais je n'arrive pas à l'intégrer...
J'ai remplacé les données

With Selection.ShapeRange
                .LockAspectRatio = msoTrue 'conserver les proportions
                .Height = h - 4
                .Left = C.Offset(0, r).Left + 2
                .Top = C.Top + 2

par celle que vous m'avez passé mais rien n'y fait!
De plus, j'ai l'impression que cela est sur la cellule D14 d'origine et non sur la fusion entre D14:H14.

 

[job75]

Bonjour Samtchevsky, le forum,

Le code étant dans le module d'une feuille [D14] ne suffit pas, il faut utiliser ActiveSheet.[D14] :

            'sélectionner l'image
            With Selection
                .ShapeRange.LockAspectRatio = msoTrue 'conserve les proportions
                .Height = ActiveSheet.[D14].Height
                .Left = ActiveSheet.[D14].Left + (ActiveSheet.[D14].MergeArea.Width - .Width) / 2
                .Top = ActiveSheet.[D14].Top
            End With

Bonne journée.