Feuilles masquées qui restent actives

[Grégf]

Bonjour,

je souhaite masquer des feuilles dans un doc et qu'elles restent actives.

Merci, cordialement.

 

[Dranreb]

J'ignorais ce phénomène avec des image de formulaire, et je ne saurais quoi y faire.
je préfèrerais de toute façon travailler avec des images ActiveX.

 

[Grégf]

Ok qu'un petit utilisateur, ça fonctionne comment les images ActiveX ?

 

[Grégf]

Je voulais dire :"Ok n'étant qu'un petit utilisateur, ça fonctionne comment les images ActiveX ?"

 

[Dranreb]

Ce ne serait pas plus simple à utiliser, ça impliquerait sans doute un module de classe, mais je suis sûr que l'image serait conservée.
Pour garder les images de formulaire il ne vous resterait donc plus qu'à trouver un moyen de copier les images d'origine à la place des miniatures lors de l'ouverture du classeur. Rien de simple, quoi qu'on fasse…

 

[Grégf]

Ok, merci d'avoir pris le temps, cordialement.

 

[job75]

Re, bonjour Bernard,

Ce n'est pas bien compliqué, utilisez ce code dans la 1ère feuille :

Const coef! = 3 'coefficient d'agrandissement, modifiable

Sub Agrandir()
Dim n
If IsError(Application.Caller) Then Exit Sub 'sécurité
n = Split(Application.Caller)(1) 'numéro de l'image
Application.ScreenUpdating = False
Sheets(CStr(n)).Shapes("Image 1").Copy
Me.Shapes(Application.Caller).TopLeftCell.Select
Me.Paste 'colle l'image
With Selection
  .Height = .TopLeftCell.Height * coef
  Fermer
  .Name = "MonImage"
  .OnAction = Me.CodeName & ".Fermer"
End With
ActiveCell.Activate
[A1].Copy [A1] 'vide le presse-papiers
End Sub

Sub Fermer()
On Error Resume Next
Me.Shapes("MonImage").Delete
End Sub

Concernant les images de la feuille PARIS MATCH :

- les liens hypertextes ont bien sûr été supprimés

- elles doivent être nommées avec le numéro/nom de la feuille correspondante (masquée) : 1 ou 2.

Fichier joint.

A+

 

[Grégf]

Bonjour et merci beaucoup JOB 75, c'est exactement ce que je voulais. Par contre malgré vos explications qui me paraissent clair je n'arrive pas à reproduire l'effet voulu quand je met une troisième image ? J'ai essayé en renommant et en affectant les macro sur l'image mais visiblement je m'y prends comme un pied. (je précise que je n'y connais rien en VBA, mais j'essaye !!!). Merci.

 

[Grégf]

AVEC LA PIECE JOINTE C'EST MIEUX ...

 

[Dranreb]

Bonjour.
Deux problèmes avec la miniature 3 :
1) — Il ne lui est pas affectée la macro Feuil1.Agrandir
2) — Elle s"appelle "Image 10" au lieu de "Image 3", or il n'existe pas de feuille "10"

 

[Grégf]

Bonjour Dranreb,
j'essaye de comprendre (pas facile j'avoue !!!) : j'affecte la macro Feuil1.Agrandir à la troisième image de l'onglet paris match ... jusque là pas de problème, mais je ne comprend comment renommer l'image si c'est bien ça qu'il faut faire. Si vous pouvez m'éclairer, merci, cordialement.

 

[Dranreb]

Lorsqu'un Shape est sélectionné son nom apparait dans la zone nom tout en haut à gauche.
Il suffit d'y taper un autre nom inexistant pour le renommer.
Cela dit on pourrait automatiser un peu plus la transformation de l'image d'origine en miniature…

 

[Grégf]

OK merci pour votre patience, j'ai enfin réussi ... pas du premier coup !!!
Il faut que je rajoute "shape" à mon dictionnaire.
Bonne journée à vous et encore un grand merci !!!
Cordialement.

 

[Dranreb]

Une version qui n'utilise qu'une procédure et s'appuie plutôt sur la colonne 1 que sur le nom du Shape :

Option Explicit
Const Coef! = 3 'coefficient d'agrandissement, modifiable

Sub Agrandir()
Dim ShpMin As Shape, Cel As Range, WshSrc As Worksheet, ShpSrc As Shape
If IsError(Application.Caller) Then Exit Sub 'sécurité
Set ShpMin = Me.Shapes(Application.Caller)
Set Cel = ShpMin.TopLeftCell
If ShpMin.Height > Cel.Height Then
   ShpMin.Height = Cel.Height
Else
'   Set WshSrc = ThisWorkbook.Worksheets(Split(ShpMin.Name)(1))
   Set WshSrc = ThisWorkbook.Worksheets(CStr(Cel.EntireRow.Columns(1).Value))
   Set ShpSrc = WshSrc.Shapes("Image 1")
   ShpSrc.Copy
   Cel.Select
   Me.Paste
   ShpMin.Delete
   Set ShpMin = Selection.ShapeRange(1)
   ShpMin.Name = "Image " & WshSrc.Name
   ShpMin.Height = Cel.Height * Coef
   ShpMin.OnAction = Me.CodeName & ".Agrandir"
   Cel.Activate
   [A1].Copy [A1]: End If 'vide le presse-papiers
End Sub

Il suffit de copier une miniature voisine, de cliquer dessus, puis sur l'image agrandie à tort

 

[Grégf]

Super ça fonctionne ... et du premier coup (il va neiger) !!!
Merci beaucoup Dranreb !!!
Cordialement.