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

Samtchevsky

XLDnaute Nouveau
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.
 

Pièces jointes

  • Fichier Test.xlsm
    98.6 KB · Affichages: 21

Samtchevsky

XLDnaute Nouveau
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.
 

Samtchevsky

XLDnaute Nouveau
Re-bonsoir,

Je suis désolé mais je n'arrive pas à l'intégrer...
J'ai remplacé les données
Code:
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

XLDnaute Barbatruc
Bonjour Samtchevsky, le forum,

Le code étant dans le module d'une feuille [D14] ne suffit pas, il faut utiliser ActiveSheet.[D14] :
Code:
            '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.
 

Discussions similaires