Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Redimensionner graphique sans proportions

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Julien_m

XLDnaute Junior
Bonjour,

J'arrive donc dans ma macro à repositionner mon graphique au centre, le redimensionner cependant cela se fait de manière proportionnelle. Je voudrais donc pouvoir réduire la largeur de mon graphique sans affecter la hauteur.

J'ai essayé ça :
VB:
Selection.ShapeRange.ScaleWidth 0.5, msoFalse, msoScaleFromMiddle

Merci par avance,

Julien.
 
Voici mon code complet :
VB:
Sub Impression()
Sheets("Calepinage").Select
    ActiveSheet.Unprotect Password:="XXX"
    ActiveSheet.Shapes.Range(Array("Group 5")).Select
    Selection.Copy
    Sheets("Impression").Select
    Cells(Rows.Count, 1).End(xlUp)(2).Select
    ActiveSheet.PasteSpecial Format:="Image (métafichier amélioré)", Link:= _
        False, DisplayAsIcon:=False
    ActiveCell.FormulaR1C1 = "1"
    Selection.ShapeRange.IncrementLeft 64.5
    Selection.ShapeRange.ScaleWidth 0.5, msoTrue, msoScaleFromMiddle' = LIGNE QUI NE FONCTION PAS COMME VOULU...
    Range("A1").Select
    Sheets("Calepinage").Select
    Range("C2:C5,C10:C11,D9:D11,F9:J11,D13,F13:J13").Select
    Range("J13").Activate
    Selection.ClearContents
    Range("C2").Select
    Sheets("Calepinage").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="XXX"
End Sub

Merci pour le code proposé, cependant je viens d'essayer ton code cependant ce dernier change les dimension de façon proportionnelle... 😕

Et je viens de trouver un truc qui me déplait dans mon code, c'est le xlUp, je préférerais que ça soit un xlDown mais en remplaçant le up par un down il y a une erreur 😡

Julien 😉
 
Dernière édition:
VB:
Sub Impression()
'
' Impression Macro
' Ajout du graphique à l'espace d'impression
'

'
    Sheets("Calepinage").Select
    ActiveSheet.Unprotect Password:="123"
    ActiveSheet.Shapes.Range(Array("Group 5")).Select
    Selection.Copy
    Sheets("Impression").Select
    Cells(Rows.Count, 1).End(xlUp)(2).Select
    ActiveSheet.PasteSpecial Format:="Image (métafichier amélioré)", Link:= _
        False, DisplayAsIcon:=False
    ActiveCell.FormulaR1C1 = "1"
    Selection.ShapeRange.Width = 150
    Selection.ShapeRange.IncrementLeft 64.5
    Range("A1").Select
    Sheets("Calepinage").Select
    Range("C2:C5,C10:C11,D9:D11,F9:J11,D13,F13:J13").Select
    Range("J13").Activate
    Selection.ClearContents
    Range("C2").Select
    Sheets("Calepinage").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="123"
End Sub

J'essaie d'envoyer mon fichier ce soir. Mais j'ai mis tout à fait ce code et je me retrouve avec une image redimensionner proportionnellement.
 
Dernière édition:
J'étais resté bloqué sur ta question de départ
Je voudrais donc pouvoir réduire la largeur de mon graphique sans affecter la hauteur.
Je pensais que tu disais que hauteur/largeur restait proportionnel ce qui n'est pas possible avec .Width = x

Alors peut-être que tu veux en plus (?) :
VB:
.LockAspectRatio = msoFalse
à mettre avant le chgmt de taille
eric
 
OUIIIIIII merci beaucoup eric 🙂 ça fonctionne parfaitement comme cela !
dernier petit truc, le xlDown doit être écrit de quelle manière pour que cela fonctionne ? Et le msoScaleFromMiddle est à mettre où?
merci, julien
 
Que veux-tu que je te dise ?
Elle doit être écrite de la façon correcte pour ton besoin.
Donc en premier lieu comprendre ce que tu utilises plutôt que d'essayer au hasard, ça t'évitera bien des déboires.

Nouveau sujet = nouveau topic à démarrer
eric
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…