Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Autres [RÉSOLU] Comment centrer les rectangles sur plage A:C

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
U

un internaute

XLDnaute Impliqué
Bonjour le forum
Il y a quelques jours danielco et fanch55 ont fait 2 petites macros. Mais comme il fallait en garder une j'ai gardé celle du fichier toto 2026
Mais sur ce fichier c'est plus compliqué il y a 6 rectangles
Un des deux pourraient-ils me faire cette petite macro?
Merci d'avance
Cordialement


VB: 
Sub CentrerRectangles()
  Dim Shp1 As Shape, Shp2 As Shape, Shp3 As Shape
  Set Shp1 = ActiveSheet.Shapes("Rectangle 30")
  Shp1.Left = ([K1].Left - Shp1.Width) / 2
  Set Shp2 = ActiveSheet.Shapes("Rectangle 32")
  Shp2.Left = (Shp1.Left - Shp2.Width) / 2
  Set Shp3 = ActiveSheet.Shapes("SeancesPlus")
  Shp3.Left = (Shp1.Width + Shp1.Left) + ([K1].Left - (Shp1.Width + Shp1.Left) - Shp3.Width) / 2
End Sub
 

Pièces jointes

Trier par date Trier par votes
Bonjour un internaute,

Utilisez :
VB: 
Sub CentrerRectangles()
Dim ref As Range, margehaut, s As Shape, n, H, W, ecartV, ecartH
Set ref = [A1:C1]
margehaut = 27.75 'place pour le titre
For Each s In ActiveSheet.Shapes
    If Not Intersect(s.TopLeftCell, ref) Is Nothing Then
        n = n + 1
        If n > 6 Then
            s.Delete 'sécurité
        Else
            If n = 1 Then
                H = s.Height: ecartV = (ref.Height - margehaut - 2 * H) / 2
                W = s.Width: ecartH = (ref.Width - 3 * W) / 4
            Else
                s.Height = H
                s.Width = W
            End If
            s.Top = IIf(n Mod 2, margehaut, margehaut + H + ecartV)
            Select Case n
                Case 1, 2: s.Left = ecartH
                Case 3, 4: s.Left = 2 * ecartH + W
                Case 5, 6: s.Left = 3 * ecartH + 2 * W
            End Select
        End If
    End If
Next
End Sub
A+
 

Pièces jointes

Vote positif 0 Vote négatif
Bonjour @un internaute 🙂, @job75 😉,

Une fonction générique qui centre une forme sur une plage en largeur ou en hauteur ou bien dans les deux sens.
VB: 
Sub CentrerFormePlage(xform As Shape, xplage As Range, Optional dimension = 0)
' xform est une forme (type Shape)
' xplage est une plage de cellules (type Range)
' dimension       : 1 ou "w" ou "W" ou "l" (lettre) ou "L" ou "x" ou "X" pour centrer en largeur
'                 : 2 ou "h" ou "H" ou "y" ou "Y" pour centrer en hauteur
'                 : n'importe quoi d'autre ou rien pour centrer en largeur et en hauteur
Dim oldSheet As Worksheet, Xcentre#, Ycentre#
   If xplage.Areas.Count > 1 Then MsgBox "Echec centrage car la plage est multi-zones!", vbCritical: Exit Sub
   If Not xplage.Parent Is xform.Parent Then MsgBox "Echec centrage car la forme et la plage ne sont pas sur la même feuille!", vbCritical: Exit Sub
   Set oldSheet = ActiveSheet: xplage.Parent.Select
   Xcentre = xplage.Left + xplage.Width / 2: Ycentre = xplage.Top + xplage.Height / 2
   If IsMissing(dimension) Then dimension = 0
   Select Case dimension
      Case 1, "w", "W", "l", "L", "x", "X"
         xform.Left = Xcentre - xform.Width / 2
      Case 2, "h", "H", "y", "Y"
         xform.Top = Ycentre - xform.Height / 2
      Case Else
         xform.Left = Xcentre - xform.Width / 2
         xform.Top = Ycentre - xform.Height / 2
   End Select
   oldSheet.Select
End Sub
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Bonjour à tous les deux
Job75
Ok mais comment tu trouves la ligne ci-dessous?
VB: 
margehaut = 27.75 'place pour le titre
On ne peut pas faire un truc très simple un "passe partout" si je puis m'exprimer ainsi en modifiant bien sûr les plages et suivant qu'il y ai 1, 2,3 Rectangles par exemple
Mais pour le fichier joint on fait comment stp?
Excuses les questions certainement un peu C$N!!
Bien cordialement
 

Pièces jointes

Vote positif 0 Vote négatif
Autre solution, un peu plus simple :
VB: 
Sub CentrerRectangles()
Dim ref As Range, margehaut, ecartV, ecartH, H, W, s As Shape, n
Set ref = [A1:C1]
margehaut = 27.75 'place pour le titre
ecartV = 5 'modifiable
ecartH = 10 'modifiable
H = (ref.Height - margehaut - 2 * ecartV) / 2
W = (ref.Width - 4 * ecartH) / 3
For Each s In ActiveSheet.Shapes
    If Not Intersect(s.TopLeftCell, ref) Is Nothing Then
        n = n + 1
        If n > 6 Then
            s.Delete 'sécurité
        Else
            s.Height = H
            s.Width = W
            s.Top = IIf(n Mod 2, margehaut, margehaut + H + ecartV)
            Select Case n
                Case 1, 2: s.Left = ecartH
                Case 3, 4: s.Left = 2 * ecartH + W
                Case 5, 6: s.Left = 3 * ecartH + 2 * W
            End Select
        End If
    End If
Next
End Sub
un internaute à dit:
Ok mais comment tu trouves la ligne ci-dessous?
VB: 
margehaut = 27.75 'place pour le titre
Cliquez pour agrandir...
En sélectionnant le 1er rectangle et en exécutant le code :
VB: 
MsgBox Selection.Top
Bonjour mapomme.
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
D'une manière générale je pense que le plus simple est d'adapter la macro à chaque plage et au nombre de Shapes.

Par exemple pour le dernier fichier du post #4 :
Code: 
Sub CentrerRectangles()
Dim ref As Range, margehaut, ecartV, ecartH, H, W, s As Shape, n
'---1ère plage---
Set ref = [A1:F1]
margehaut = 26 'place pour le titre
ecartV = 5 'modifiable
ecartH = 10 'modifiable
H = ref.Height - margehaut - ecartV
W = (ref.Width - 4 * ecartH) / 3
For Each s In ActiveSheet.Shapes
    If Not Intersect(s.TopLeftCell, ref) Is Nothing Then
        n = n + 1
        s.Height = H
        s.Width = W
        s.Top = margehaut
        Select Case n
            Case 1: s.Left = ecartH
            Case 2: s.Left = 2 * ecartH + W
            Case 3: s.Left = 3 * ecartH + 2 * W
        End Select
    End If
Next
'---2ème plage, centrage simple de la Shape existante---
Set ref = [G1:I1]
For Each s In ActiveSheet.Shapes
    If Not Intersect(s.TopLeftCell, ref) Is Nothing Then
        s.Top = (ref.Height - s.Height) / 2
        s.Left = ref.Left + (ref.Width - s.Width) / 2
    End If
Next
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
Bonjour le forum,

Bon comme mapomme j'ai créé une macro générique, c'est à dire paramétrée fonctionnant dans tous les cas :
VB: 
Sub CentrerRectangles(ref As Range, nH, nV, margeHaut, ecartV, ecartH)
Dim H, W, s As Shape, n, i, j
H = (ref.Height - margeHaut - nV * ecartV) / nV
W = (ref.Width - (nH + 1) * ecartH) / nH
For Each s In ActiveSheet.Shapes
    If Not Intersect(s.TopLeftCell, ref) Is Nothing Then
        n = n + 1
        s.Height = H
        s.Width = W
        i = (n - 1) Mod nV
        s.Top = ref.Top + margeHaut + i * (H + ecartV)
        j = Int((n - 1) / nV)
        s.Left = ref.Left + ecartH + j * (W + ecartH)
    End If
Next
End Sub
Dans le fichier toto 2026.xls elle est lancée par :
VB: 
Sub Cadrer()
CentrerRectangles [A1:C1], 3, 2, 27.75, 5, 10
CentrerRectangles [I2:I4], 1, 1, 4, 4, 4
End Sub
et dans le fichier toto_Charges.xls par :
VB: 
Sub Cadrer()
CentrerRectangles [A1:F1], 3, 1, 26, 5, 10
CentrerRectangles [G1:I1], 1, 1, 15, 15, 30
End Sub
A+
 

Pièces jointes

Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

U
  • Question Question
Autres Possibilité de faire une macro?
Réponses
10
Affichages
147
un internaute
U
U
  • Résolu(e)
Autres Centrer ou Annuler Centrer
Réponses
12
Affichages
602
un internaute
U
  • Question Question
XL 2016 XLS - Comment déterminer les zones présentent au niveau d'une cellule ?
Réponses
2
Affichages
199
Lu76Fer
C
  • Question Question
Centrer image sur cellules ou cellulles fusionnées avec sélection manuelle
Réponses
2
Affichages
2 K
Canklown
C
A
  • Question Question
Bulles se positionnent sur une image comme on veut (VBA)
Réponses
0
Affichages
6 K
awa123
A
M
[REF] Wiki 1 de MichelXld (Généralités Excel)
Réponses
6
Affichages
60 K
Le_Phénomène
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…