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

Redimensionner graphique sans proportions

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.
 

Julien_m

XLDnaute Junior
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:

Julien_m

XLDnaute Junior
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:

eriiic

XLDnaute Barbatruc
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
 

Julien_m

XLDnaute Junior
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
 

eriiic

XLDnaute Barbatruc
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
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…