Discussion :

[Simon64]

Bonjour

Je suis actuellement edans une entreprise où la matière première utilisée est le maïs .
Ce maïs est stocké dans des silos cylindriques à fond plat et je souhaiterai modéliser cette forme sur excel à partir d'une base de donnée ( diametre, hauteur, formule de volume cylindre et cône).
Le résultat que je souhaite obtenir est le suivant : lorsqu'on modifie les données de hauteur ou de diametre que le cylindre change de dimension et pouvoir empilé un cône sur le cylindre.
Je ne sais pas si c'est réalisable, c'est pour ça que je demande votre aide.

En vous remerciant

[Daniel.C]

Bonjour,

Je n'ai pas de cône à ma disposition, mais si tu acceptes un rectangle et un triangle, c'est possible.

[Simon64]

Merci Daniel,
J'accepte tes conseils ca c'est vrai qu'en ramenant en 2D un cylindre et un cône cela fait un rectangle et un triangle !

[Daniel.C]

J'ai finalement utilisé des pentagones.
Voici le code :
1. Dans un module standard :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Option Base 1
Public Silos(100), H(100) As Single, D(100) As Single

Si tu as plus de 100 silos, ajuste en conséquence.

Dans le module "Thisworkbook" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub Workbook_Open()
Dim c As Range, ResAdr As String
With Sheets("Feuil1")
    Set c = .[A:A].Find("Silo")
    If Not c Is Nothing Then
        ResAdr = c.Address
        Do
            ctr = ctr + 1
            vars = Dims
            Silos(ctr) = c.Value
            H(ctr) = c.Offset(1, 1)
            D(ctr) = c.Offset(2, 1)
            Set c = [A:A].FindNext(c)
        Loop Until c Is Nothing Or c.Address = ResAdr
    End If
End With
End Sub

Dans le module de la feuille :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Silo As String, NouvH As Single, AncH As Single, AncD As Single, NouvD As Single
    If Target <> "" And Target <> 0 And Target.Count = 1 And _
        Target.Column = 2 Then
        With Application
            If Left(Target.Offset(-1, -1), 4) = "Silo" Then
                Silo = Target.Offset(-1, -1)
                Set Var = ActiveSheet.Shapes(Silo)
                AncH = .Index(H, .Match(Target.Offset(-1, -1).Value, Silos, 0))
                NouvH = Target.Value
                Shapes(Silo).Height = Shapes(Silo).Height * NouvH / AncH
                H(.Match(Target.Offset(-1, -1).Value, Silos, 0)) = NouvH
            ElseIf Left(Target.Offset(-2, -1), 4) = "Silo" Then
                Silo = Target.Offset(-2, -1)
                AncD = .Index(H, .Match(Target.Offset(-2, -1).Value, Silos, 0))
                NouvD = Target.Value
                Shapes(Silo).Width = Shapes(Silo).Width * NouvD / AncD
                H(.Match(Target.Offset(-2, -1).Value, Silos, 0)) = NouvD
            End If
        End With
    End If
End Sub

Je te joins un classeur exemple. Les noms des silos doiant se trouver en colonne A et commencer par "Silo".