Redimensionner graphique sans proportions

Julien_m · 9 Avril 2019

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.

eriiic · 10 Avril 2019

Bonjour,

voir les propriétés Height et Width
eric

Julien_m · 10 Avril 2019

eriiiic à dit:
Bonjour,

voir les propriétés Height et Width
eric

Bonjour,

Merci mais comment doivent elles être incorporées dans le code ?

eriiic · 10 Avril 2019

Bonjour,

commence par regarder l'aide dessus, il y a souvent un exemple.
eric

Julien_m · 10 Avril 2019

Re,

Je patauge un peu là... J'ai beau essayer ça ne veut pas.
Auriez vous un lien, un exemple svp.

Merci.

eriiic · 10 Avril 2019

essaie avec :

VB:

Selection.ShapeRange.Width =150

eric

Julien_m · 10 Avril 2019

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

eriiic · 10 Avril 2019

Non mais c'est pour remplacer ton Selection.ShapeRange.ScaleWidth
eric

Julien_m · 10 Avril 2019

Oui j'avais compris, c'est ce que j'ai fais mais ça reste proportionnel...

eriiic · 10 Avril 2019

Le code que tu montres oui.
Mais avec ce que je t'indique ça m'étonnerait fort.
Comme tu es le seul à voir ce que tu as modifié ça va en rester là.
eric

Julien_m · 10 Avril 2019

eriiiic à dit:
Le code que tu montres oui.
Mais avec ce que je t'indique ça m'étonnerait fort.
Comme tu es le seul à voir ce que tu as modifié ça va en rester là.
eric

J'ai modifié dans mon commentaire juste la partie où j'avais mon deuxième problème rien d'autre

Julien_m · 10 Avril 2019

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.

eriiic · 10 Avril 2019

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 · 10 Avril 2019

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 · 10 Avril 2019

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

Redimensionner graphique sans proportions

Julien_m

XLDnaute Junior

eriiic

XLDnaute Barbatruc

Julien_m

XLDnaute Junior

eriiic

XLDnaute Barbatruc

Julien_m

XLDnaute Junior

eriiic

XLDnaute Barbatruc

Julien_m

XLDnaute Junior

eriiic

XLDnaute Barbatruc

Julien_m

XLDnaute Junior

eriiic

XLDnaute Barbatruc

Julien_m

XLDnaute Junior

Julien_m

XLDnaute Junior

eriiic

XLDnaute Barbatruc

Julien_m

XLDnaute Junior

eriiic

XLDnaute Barbatruc

Discussions similaires