Insertion et dimension d'un shape

Patricia25

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

Code:
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 :)
 

mromain

XLDnaute Barbatruc
Re : Insertion et dimension d'un shape

bonjour Patricia25,
bonjour tototiti2008


Voici un essai à adapter.
VB:
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+
 
Dernière édition:

Patricia25

XLDnaute Nouveau
Re : Insertion et dimension d'un shape

Whaou merci mromain et tototiti2008 !!
Vous avez été extrêmement rapide :D!
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 :eek:)

En tout cas merci beaucoup à vous et bonne fin de journée ;):D
 

Discussions similaires

Statistiques des forums

Discussions
299 952
Messages
1 980 342
Membres
207 062
dernier inscrit
K2OPA