Insérer shape les unes à coté des autres
Bonjour,
J'ai créer un macro qui insérer des shapes ( carré et ovale) sur une feuille les une à coté des autres, sur une même ligne.
La largeur des objets insérée peut variée en fonction des informations contenus dans les celulles T5 à T8.
J'arrive bien à les insérer sur la même ligne, mais je n'arrive pas à faire en sorte que l'écartement entre chaque figure soit le même.
Ci joint le fichier pour mieux comprendre
Bonsoir,
à placer juste avant le "next x" :
' si on est à la création du deuxième shape alors on le décale à 3 points du bord droit du précédent
If x > 1 Then ActiveSheet.Shapes("figure " & x).Left = ActiveSheet.Shapes("figure " & x - 1).Left + ActiveSheet.Shapes("figure " & x - 1).Width + 3@ bientôt
LouReeD
Bonjour LouReeD
Merci beaucoup pour ta réactivité. Ça fonctionne bien.
Cordialement
Bonjour à tous,
Il y a aussi la propriété ShapeRange.Distribute method (Excel) | Microsoft Learn qui est intéressante, mais je n'ai pas réussi à la mettre en place sur ton fichier. Pour une raison étrange je ne suis jamais arrivé à récupérer la ShapeRange (= liste de formes nécessaire) pour y appliquer la distribution horizontale.
Je mets ça là car c'est une alternative (en théorie) sans prise de tête pour ce problème.
N'oublie pas de valider la réponse de @LooReed
bonjour le fil,
@Saboh12617, ceci est pour vous montrer ce "distribute", mais apart de cette démonstration, ce n'st pas mieux de ce que LouReeD a fait .... c'est moins pratique
Sub Saboh()
Dim aShapes(1 To 8), Gauche, Largeur, sHp
Gauche = 200
With ActiveSheet
For i = 1 To UBound(aShapes) '
aShapes(i) = "Figure " & i
Largeur = Largeur + .Shapes(aShapes(i)).Width
Next
Set sr = ActiveSheet.Shapes.Range(aShapes)
sr.Align msoAlignMiddles, msoFalse
sr.Align msoAlignCenters, msoFalse
sr.Top = 200
sr.Left = Gauche
'ce 2eme boucle est pour déplacer les shapes dans la séquence voulue, autrement la macro les met assez aléatoire
For i = 1 To UBound(aShapes)
Set sHp = .Shapes(aShapes(i))
sHp.Left = Gauche + IIf(i < UBound(aShapes), 5 * (i - 1), Largeur - sHp.Width)
Next
sr.Distribute msoDistributeHorizontally, msoFalse
End With
End SubBonjour,
pour le fun avec l'option distribution puis mise en variable le nombre de shape à créer :
Le code :
Sub Boutons()
ActiveSheet.Calculate
Dim x As Integer, y As Integer, z As Integer, a As Integer, b As Integer, c As Integer, e As Integer, f As Integer
Dim Sh As Shape, LargSeq As Double, Arr()
y = [NB_Sh]
If Not (y > 2 And y < 16) Then Exit Sub
Application.ScreenUpdating = False
With ActiveSheet
For Each Sh In .Shapes
If Not Sh.Name Like "Bouton" Then Sh.Delete
Next Sh
For x = 1 To y
If Cells(1, x).Value = 1 Then
' ici on ajoute un décalage de 5 point entre chaque shapes à la création
' afin de garder l'ordre numérique lors de la distribution horizontale d'où le 45 + (5*x)
Set Sh = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 45 + (5 * x), 40, Cells(5, 20), Cells(6, 20))
Else
Set Sh = ActiveSheet.Shapes.AddShape(msoShapeOval, 45 + (5 * x), 40, Cells(7, 20), Cells(8, 20))
End If
With Sh
.Name = ("figure " & x)
' on incrémente la largeur de la séquence
LargSeq = LargSeq + .Width + 1
' on ajoute le nom du shape
ReDim Preserve Arr(1 To x)
Arr(x) = .Name
End With
Next x
' on place la figure Y où l'on veut
' ici elle est placée à la largeur total de la séquence des Y shapes
' de la création des shapes
.Shapes("figure " & y).Left = .Shapes("figure 1").Left + LargSeq
' on sélection les Y shapes grace au tableau arr
.Shapes.Range(Arr).Select
' on applique la distribution
Selection.ShapeRange.Distribute msoDistributeHorizontally, msoFalse
.Range("A1").Activate
End With
End SubAttention ! cette technique ne supporte pas le fait de n'avoir que deux shapes !
@ bientôt
LouReeD
avec ceci la limite inférieur de y est 1 et on doit soustraire la largeur du dernier shape du total pour mieux placer les shapes
If y > 1 Then .Shapes("figure " & y).Left = .Shapes("figure 1").Left + LargSeq - .Shapes("figure " & y).Width
' on sélection les Y shapes grace au tableau arr
If y > 2 Then .Shapes.Range(Arr).Distribute msoDistributeHorizontally, msoFalseet puis ce +1 ? négligeable ?
LargSeq = LargSeq + .Width + 1c'est amusant, mais placer les shapes directement au bon endroit, c'est plus pratique ....
Merci BsAlv !
Code modifié selon les remarques de BsAlv :
Sub Boutons()
ActiveSheet.Calculate
Dim X As Integer, Y As Integer
Dim Sh As Shape, LargSeq As Double, Arr()
Y = [NB_Sh]
Application.ScreenUpdating = False
With ActiveSheet
For Each Sh In .Shapes
If Not Sh.Name Like "Bouton" Then Sh.Delete
Next Sh
For X = 1 To Y
If Cells(1, X).Value = 1 Then
' ici on ajoute un décalage de 5 point entre chaque shapes à la création
' afin de garder l'ordre numérique lors de la distribution horizontale d'où le 45 + (5*x)
Set Sh = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 45 + (5 * X), 40, Cells(5, 20), Cells(6, 20))
Else
Set Sh = ActiveSheet.Shapes.AddShape(msoShapeOval, 45 + (5 * X), 40, Cells(7, 20), Cells(8, 20))
End If
With Sh
.Name = ("figure " & X)
' on incrémente la largeur de la séquence
LargSeq = LargSeq + .Width
' on ajoute le nom du shape dans le tableau
ReDim Preserve Arr(1 To X)
Arr(X) = .Name
End With
Next X
' on place la figure Y où l'on veut ici elle est placée à la largeur totale de la séquence des Y shapes de la création des shapes
' moins la largeur du dernier shape !
.Shapes("figure " & Y).Left = .Shapes("figure 1").Left + LargSeq - .Shapes("figure " & Y).Width
If Y > 2 Then .Shapes.Range(Arr).Distribute msoDistributeHorizontally, msoFalse
End With
End SubEt si vous ne voulez pas que les shapes se touchent alors il faut ajouter 1,5 au Width : LargSeq = LargSeq + .Width + 1.5
@ bientôt
LouReeD