Insertion et dimension d'un shape

[Patricia25]

Bonjour à tous !

J'aurais besoin d'un petit coup de main pour mon fichier.

Je suis en train de faire une gestion des flux matière. Pour cela, j'ai créé mon plan d'entreprise dans une feuille et j'aurais aimé à l'aide d'un rectangle, matérialiser le chemin que la matière parcoure dans l'entreprise. Pour cela je fais apparaitre un 1er rectangle dans la première cellule de ma feuille. Au bout de 2 secondes, il faudrait qu'un 2ème rectangle se place en A2. Et ainsi de suite jusqu'à ce que le flux soit totalement matérialisé par les rectangles!!

Petit résumé :
- Insérer un rectangle aux dimensions de la cellule A1 dans la cell A1
- Attendre 2 secondes, a l'aide d'un timer
- Insérer un rectangle aux dimensions de la cellule A2 dans la cell A2

J'ai récupéré un petit bout de code pour l'insertion d'un rectangle :

Sub insertion()
With Sheets(1).Shapes.AddShape(msoShapeRectangle, 50, 50, 10, 10)
'expression.AddShape(Type, Left, Top, Width, Height)
.Name = "flux" ' changer le nom du shapes
End With
End Sub

Mais le problème c'est que je ne sais pas comment le mettre aux dimensions de ma cellule A1 et l'intégrer DANS la cellule A1 !!
Et il me reste encore le problème de la temporisation !

Merci à tous pour votre aide

 

[tototiti2008]

Re : Insertion et dimension d'un shape

Bonjour Patricia,

un essai

Edit : Bonjour mromain

 

[mromain]

Re : Insertion et dimension d'un shape

bonjour Patricia25,
bonjour tototiti2008


Voici un essai à adapter.

Sub Test()
Dim iCol As Long
    'boucler sur les 5 premières colonnes
    For iCol = 1 To 5
        'ajouter un rectange dans la cellule
        AjouterRectange Cells(1, iCol), "Test" & iCol
        'attendre 2 secondes
        Application.Wait Now + TimeValue("00:00:02")
    Next iCol
End Sub



Public Sub AjouterRectange(cellule As Range, Optional nomShape As String = "")
Dim laShape As Shape
    'créer un rectangle sur la cellule
    Set laShape = ThisWorkbook.Sheets(cellule.Parent.Name).Shapes.AddShape(msoShapeRectangle, cellule(1, 1).left, cellule(1, 1).top, cellule(1, 1).width, cellule(1, 1).height)
    'modifier le nom du rectangle si un nom a été passé en paramètre
    If nomShape <> "" Then laShape.Name = nomShape
End Sub

a+

 

[Patricia25]

Re : Insertion et dimension d'un shape

Whaou merci mromain et tototiti2008 !!
Vous avez été extrêmement rapide !
Et en plus ça marche parfaitement! J'ai adapté rapidement (pour tester) le code de mromain. Pour ton code tototiti2008 je n'ai encore par testé mon adaptation (le boulot m'appel )

En tout cas merci beaucoup à vous et bonne fin de journée

 

[ChTi160]

Re : Insertion et dimension d'un shape

Salut Patricia25
Bonjour le Fil
Bonjour le Forum

arff vous êtes trop rapide lol

j'ai adapté une partie d'un code

voir le fichier Joint

le fichier : Regarde la pièce jointe Triangle Classeur1V2.xls

Bonne journée

 

[Patricia25]

Re : Insertion et dimension d'un shape

Merci ChTi160 !
Ton fichier marche parfaitement et est très bien commenté ! Il m'est d'une grande aide encore merci !!

 

[ChTi160]

Re : Insertion et dimension d'un shape

Salut Patricia25
Bonjour le Fil
Bonjour le Forum

Ok

Bonne fin de journée