Agrandissement photo

Bonjour à toutes et tous,

Nouveau sur ce forum j'espère ne pas arriver avec mes gros sabots et vous en demander de trop d'un coup :-D

Très TRES novice avec VBA, Je souhaite faire un excel un peu particulier.

Je vous explique en quelques mots la situation.

En gros je voudrais pouvoir créer une macro à assigner à une photo. Cette macro aurait pour fonction que lorsque je clic sur la photo celle-ci s'agrandi x fois et lorsque je REclic sur cette photo agrandie elle revienne à son emplacement initial età sa taille du début.

Je vous avoue avoir profiter de ChatGPT mais malgré toute son intélligence je n'y parviens pas.

J'espère que vous aurez suffisament d'élément pour m'aider.

D'avance un grand merci à vous ;-)

Bonjour,

Prenez l’habitude de joindre un classeur représentatif à l'appui de vos demandes cela permettrait aux intervenants de répondre plus précisément à la question, et aussi à nous éviter de créer un fichier en blanc pour voir si le fonctionnement du besoin est opérationnel.

Slts

Bonjour,

Je ne sais pas du tout si cela vous conviens. En résumé j'ai plusieurs feuilles et mon objectif est vraiment d'avoir des photos miniature que je pourrais agrandir en cliquant dessus . Je vais régulièrement ajouter des photos et je voudrais donc automatiser ce process (avec un bouton ou un clic peut importe) mais que les photos ne prennent pas toute la place.

j'ai tenté Chatgpt mais rien n'y fais rien ne se passe -->

Option Explicit

Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
' Vérifier si la cible est une image
If TypeName(Target) = "Picture" Then
ToggleImageSize Target
' Annuler le double clic standard pour éviter l'édition de la cellule
Cancel = True
End If
End Sub

Sub ToggleImageSize(img As Object)
' Sauvegarder l'emplacement initial
Dim initialLeft As Double
Dim initialTop As Double
initialLeft = img.Left
initialTop = img.Top

' Vérifier si l'image est déjà agrandie
If img.ShapeRange.ScaleWidth <> 1 Then
' Si agrandie, la ramener à la taille initiale et à l'emplacement initial
img.ShapeRange.ScaleWidth = 1
img.ShapeRange.ScaleHeight = 1
img.Left = initialLeft
img.Top = initialTop
Else
' Si non agrandie, agrandir 3 fois
img.ShapeRange.ScaleWidth 3, msoFalse, msoScaleFromTopLeft
img.ShapeRange.ScaleHeight 3, msoFalse, msoScaleFromTopLeft
End If
End Sub

Bonsoir Renal1989, le Fil,

Nomme tes photos avec un nom court ou 3 chiffres suivis de l'underscore _ puis de leur hauteur puis de _ suivi de leur largeur en taille minimale, décimales comprises.

Ensuite il faut appliquer à toutes tes photos la macro ci-dessous.

Sub RedAug()

Sub RedAug()
Nom = Application.caller
Haut =Cdbl(Split(Nom, "_") (1)) 
Larg = Cdbl(Split(Nom, "_") (2)) 
With ActiveSheet.shape(Nom)
Select Case Haut
Case < Haut + 1
.Height = Haut * 3
.width = Larg * 3
Case > Haut
. Height = Haut
. Width = Larg
End select
End with
End sub

Si besoin fais un retour, car là je te réponds par phone. Je te contrôlerais ce soir en arrivant chez moi.

Bonjour,

Regarde si le fichier joint, peux te convenir, je le sort de mes archives

Slts

Bonsoir Renal1989, boss_68, X Cellus, le forum,

Un autre essai en utilisant un facteur d'agrandissement des photos (modifiable). Ça donne ceci :

Quelques indications d'utilisation dans le classeur joint :

Cordialement.

AL 22

Hello à tous... La solution de Al 22 est vraiment top

Quand je vous dis que je suis un débutant... Comment pourrais-je l'appliquer à mon classeur ?

La première page "stations" permet de choisir la stations et dirige vers une feuille précise.

Pour le moment j'ai inséré les photos dans la feuille :"Porte de Hall" mais je voudrais pouvoir en ajouter dans chaque station...

Dans tous les cas un grand grand merci pour votre aide ;-)

EDIT pour la solution de Boss_68 elle est vraiment top aussi en fait (plus "stable que celle de AL22) mais j'ai peur de ne pas pouvoir envoyer ce classeur (comme les photos ne sont pas sur le odc mais sur mon onedrive)

Bonjour Renal1989, bonjour à tous,

Vous n'aurez pas grand chose à faire avec le classeur joint !

Ajoutez toutes les photos que vous voulez et rendez-vous dans la feuille "Stations". (attention au "poids" du classeur...)

Dans cette feuille, il y a un "bouton" bleu (Macro photos), cliquez dessus et toutes les photos du classeur seront affectées d'une macro quelque soit la feuille ou elles se trouvent. Modifiez le facteur d'agrandissement selon vos besoins (attention, la qualité des photos s'en ressentira). Testez !

J'ai légèrement modifié la macro qui permet d'agrandir les photos pour assurer une fiabilité plus précise (chevauchement, repositionnement).

Si vous ajoutez épisodiquement des photos, il faudra relancer la macro d'affectation de la feuille "Stations".

Cordialement.

AL 22

Merci vraiment AL22

C'est vraiment ce que j'avais besoin.

je fais le difficile jusqu'au bout. Comment garder une qualité de photo acceptable ? :-D

En effet la qualité en prend un coup lorsqu'on fait un agrandissement.

Edit bon finalement c'est incompréhensible quand j'ajoute une photo la qualité reste top je peux jouer (agrandir et refermer la photo 50x sans problème) mais à un certain moment sans que je touche au classeur, la qualité se dégrade totalement. bizarre vous avez dit bizarre

Re,

Oulala...,

Sur la qualité des photos et d'après la description que vous faîtes je ne pourrais pas tellement vous aider.

En faisant un clic droit sur la photo, vous avez accès aux "Formats de l'image..." (dernier menu), ce qui vous permettra de pouvoir corriger la netteté, la luminosité ou le contraste. Mais bon, je ne suis pas sûr que cela vous aide, désolé...

A+

AL 22

Pour info : Je pense avoir trouvé la solution

Files -> Options -> Advanced -> Image Size and Quality -> cocher la case Do Not compress images in file.