animer schéma selon valeur de cellule

[chinel]

Bonjour je cherche à faire une animation selon valeur de cellules
exemple: je mets en cellule A1 une donnée style 10cm la longueur et en A2 je mets 20cm cela me donnera un rectangle de 20cm sur 10cm
j'ai ceci mais cela fonctionne pas bien !

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$9" Or Target.Address = "$C$10" Then
ActiveSheet.Shapes("Rectangle 10").Top = [G13].Top - [G13].Width * [C9].Value * 7 / [C10].Value
ActiveSheet.Shapes("Rectangle 10").Width = [G13].Top - ActiveSheet.Shapes("Rectangle 10").Top
End If
End Sub


Merci de votre aide !

 

[Staple1600]

Re : animer schéma selon valeur de cellule

Bonsoir chinel, re cc


Un exemple à titre illustratif

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 28/07/2011 par EXCEL
'

Dim Lar&, Longu&, Dimens
Dimens = InputBox("Largeur,Longueur", "Dimension rectangle en cm", "5,15")
Lar = CLng(Split(Dimens, ",")(0))
Longu = CLng(Split(Dimens, ",")(1))
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 255#, 116.25, 115.5, 48.75). _
        Select
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.Height = Lar / 3.52733686067019E-02
    Selection.ShapeRange.Width = Longu / 3.52733686067019E-02
   
End Sub

Je te laisse adapter en te basant sur des valeurs dans dans cellules et non pas provenant d'un inputbox.

 

[JCGL]

Re : animer schéma selon valeur de cellule

Bonjour à tous,

Tes valeurs en A1 et A2 et ceci dans le code de la feuille :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    With ActiveSheet
        .DrawingObjects.Delete
        .Shapes.AddShape(msoShapeRectangle, 100#, 50#, Cells(2, 1) * 28.35, Cells(1, 1) * 28.35).Select
        Cells(1, 1).Select
    End With
End Sub

A + à tous

 

[Staple1600]

Re : animer schéma selon valeur de cellule

Bonsoir JCGL


C'est vrai que multiplier c'est mieux que diviser 😱

J'ai honte je vais me coucher.

 

[chinel]

Re : animer schéma selon valeur de cellule

Que dire ? Trop fort !!! un grand merci à vous !