XL 2013 Boucle avec des formes

[Noopy123]

Bonjour a tous,

J'aimeras savoir s'il est possible et si c'est le cas, de créer une boucle pour insérer des formes rectangles dans une plage de cellule via VBA
J'aimerais créer un rectangle dans chaque cellule d'une plage allant de la cellule B2 à G8

Merci pour votre aide précieuse

 

[sylvanu]

Bonsoir Noopy,
Un essai :

Sub Rectangle()
For L = 2 To 8
    For C = 2 To 7
        With Cells(L, C)
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height).Select
        End With
    Next C
Next L
[A1].Select
End Sub

 

[_Thierry]

Bonsoir Noopy, Sylvanu

Bien vu et très efficace Sylvanu !
C'est hors sujet, mais ca m'a fait penser à un truc pour un petit cadeau pour Sylvanu

Bien à toi, à vous
@+Thierry

 

[sylvanu]

Re,
En période de confinement, ... on pourrait en faire un puzzle !

 

[_Thierry]

Re,

Pour rendre à César ce qui est à César ! C'est fait avec ce bon vieux programme d'un Excellent contributeur d'XLD, Thierry Pourtier "Ti" (sur XLD et sur VeriTi avec Veriland) qui nous a malheuresement quitté suite à un accident de moto il y a déjà pas mal d'années...

En son hommage, je le mets en pièce jointe

Avec un pensée pour Ti
@+Thierry

PS il était aussi l'auteur de "Acyd.xls" un utilitaire qui a fait le tour de la planète...

 

[Noopy123]

Génial, ça marche au top
Merci beaucoup

 

[Noopy123]

J'avais une autre petite question que j'ai oublié de vous soumettre.
Est-il possible de commencer une boucle à partir d'une cellule définie, c'est à dire, j'aimerai faire une autre boucle dans le même style que celle pour créer les rectangle mais en commençant cette boucle à partir de la cellule sélectionner (par exemple la cellule H2). Il faudrait que la boucle commence dans la cellule bien précise et non avec un OffSet (oui je suis exigeante )

Merci par avance

 

[sylvanu]

Bonsoir,
Very sample :

Sub Rectangle()
X = ActiveCell.Row               ' définit la ligne de la cellule active
Y = ActiveCell.Column         ' définit la colonne de la cellule active
For L = X To X + 8                ' 8 est le nombre de rectangles en X
    For C = Y To Y + 5           ' 5 est le nombre de rectangles en Y
        With Cells(L, C)
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height).Select
        End With
    Next C
Next L
[A1].Select
End Sub

Si j'ai bien compris.

 

[Noopy123]

C'est magnifique !!! Exactement ce que je voulais
Mille mercis

 

[Noopy123]

A chaque jour sa question ( oui je suis une véritable casse pied ^^)
Est-il possible de creer un rectangle à partir d'une cellule active et qui prend 4 cellules.
Je m’explique :
si ma cellule active est la cellule W4, est-il possible de creer un rectangle qui englobera les cellules W4,W5,X4 et X5 ?
et de faire en sorte que les prochaines formes ajoutées ne se chevauchent pas si la largueur est supérieure à la taille de la cellule ?

Encore merci par avance

 

[sylvanu]

Bonjour Noopy,

La syntaxe de Shapes.addShape est :

Shapes.AddShape, méthode (Excel)

Rubrique de référence sur Office VBA

docs.microsoft.com

Il vous suffit de faire varier Width et Height,et non les limiter à une cellule.

 

[Noopy123]

Bonjour Sylvanu,

J'ai essayé cette technique mais le problème est que comme les rectangles respecte la taille des cellules ils se chevauchent et ne se mettent pas en ligne droite. J'ai essayé avec un format XlMove et XlFreefloating mais ils restent chevauché si je change Width et Height :/

 

[Noopy123]

J'ai fait un capture pour expliquer visuellement mon problème qui sera surement plus explicite que de long discours ^^

 

[sylvanu]

Un exemple de 9*7 carrés, de 1 colonne sur 5 lignes.

Sub Rectangle()
X = ActiveCell.Row                  ' définit la ligne de la cellule active
Y = ActiveCell.Column               ' définit la colonne de la cellule active
For L = X To X + 30 Step 5          ' 7 rectangles en X de 5 lignes de haut
    For C = Y To Y + 8              ' 9 rectangles en Y
        With Range(Cells(L, C), Cells(L + 4, C))
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height).Select
        End With
    Next C
Next L
[A1].Select
End Sub

Il faut définir la zone où voulez la figure avec le Range(Cells(),Cells())

 

[Noopy123]

Merci beaucoup,
J'avais essaye avec range mais je ne l'avais pas bien formulé donc forcement pas de résultat ^^
Et si je change Width qui sera plus grande que la taille d'une cellule est-il possible de faire en sorte que le rectangle 1 rectangle respecte la cellule active et que les autres se mettent à la suite ?
Le but est d'atteindre le résultat entouré en rouge (que j'ai fais en copier coller raison pour laquelle j'y suis arrivée ^^) car même en adaptant range, les formes continuent à respecter chaques cellules (sur les formes en bleue Width a été modifié)
Je ne sais pas si ce que je veux faire est possible...