Centrer 3 rectangles

Question

Il y a quelques jours BsAlv m'a fait une macro que je voudrais adapter au fichier joint Les rectangles 91 et 115 ont les mêmes dimensions Si tu es sur le forum ou autre je veux bien Rien ne presse Merci à vous Cordialement PS: Je suis encore sous Excel 2003.... interdit de rigoler!!! VBA mesure en points et 1 cm est 28.35 points Sub center() x = 28.35 'nombre de points dans 1 cm Set shp = ActiveSheet.Shapes("rectangle 84") 'au lieu de 1, le nom du rectangle shp.Left = Application.Max(0, (Range("K1").Left - shp.Width) / 2) shp.Top = 0 MsgBox "largeur : " & shp.Width & " points ou " & Format(shp.Width / x, "0.00") & " cm" & vbLf & _ "hauteur : " & shp.Height & " points ou " & Format(shp.Height / x, "0.00") & " cm" & vbLf & _ "gauche : " & shp.Left & " points ou " & Format(shp.Left / x, "0.00") & " cm" & vbLf & _ "gauche de cellule K1 : " & Range("K1").Left & " points ou " & Format(Range("K1").Left / x, "0.00") & " cm" & vbLf & vbLf & _ " 2 * " & Format(shp.Left / x, "0.00") & " cm + " & Format(shp.Width / x, "0.00") & " cm = " & Format(Range("K1").Left / x, "0.00") & " cm" _ , vbInformation, UCase("Dimensions de " & shp.Name) End Sub J'ai transformé la macro comme ci-dessous sans les commentaires Sub CenterHorizontalementRectangle() X = 28.35 'nombre de points dans 1 cm Dim Shp1 As Shape, Shp As Shape Set Shp = ActiveSheet.Shapes("Rectangle 98") 'Nom du Rectangle Shp.Left = Application.Max(0, (Range("K1").Left - Shp.Width) / 2) 'Le domaine à centrer est de A1:J1 donc K1 dans la macro Set Shp1 = ActiveSheet.Shapes("Rectangle 100") 'Nom du Rectangle Shp1.Left = Range("K1").Left / 2 - Shp1.Width - 30 'Distance entre les 2 rectangles Set Shp1 = ActiveSheet.Shapes("SeancesPlus") 'Nom du Rectangle Shp1.Left = Range("K1").Left / 2 + 30 'Distance entre les 2 rectangles End Sub Sub CenterHorizontalementRectangle() X = 28.35 'nombre de points dans 1 cm Dim Shp1 As Shape, Shp As Shape Set Shp = ActiveSheet.Shapes("Rectangle 98") 'Nom du Rectangle Shp.Left = Application.Max(0, (Range("I1").Left - Shp.Width) / 2) 'Le domaine à centrer est de A1:H1 donc I1 dans la macro Set Shp1 = ActiveSheet.Shapes("Rectangle 100") 'Nom du Rectangle Shp1.Left = Range("I1").Left / 2 - Shp1.Width - 30 'Distance entre les 2 rectangles Set Shp1 = ActiveSheet.Shapes("SeancesPlus") 'Nom du Rectangle Shp1.Left = Range("I1").Left / 2 + 30 'Distance entre les 2 rectangles End Sub je n'avais pas modifié la macro pour la colonne à adapter I1 à la place de K1 'Sub CenterHorizontalementRectangle() ' X = 28.35 'nombre de points dans 1 cm ' Dim Shp1 As Shape, Shp As Shape ' Set Shp = ActiveSheet.Shapes("Rectangle 98") 'Nom du Rectangle ' Shp.Left = Application.Max(0, (Range("I1").Left - Shp.Width) / 2) 'Le domaine à centrer est de A1:H1 donc I1 dans la macro ' Shp.Top = 0 ' ' MsgBox "largeur : " & Shp.Width & " points ou " & Format(Shp.Width / X, "0.00") & " cm" & vbLf & _ ' "hauteur : " & Shp.Height & " points ou " & Format(Shp.Height / X, "0.00") & " cm" & vbLf & _ ' "gauche : " & Shp.Left & " points ou " & Format(Shp.Left / X, "0.00") & " cm" & vbLf & _ ' "gauche de cellule I1 : " & Range("I1").Left & " points ou " & Format(Range("I1").Left / X, "0.00") & " cm" & vbLf & vbLf & _ ' " 2 * " & Format(Shp.Left / X, "0.00") & " cm + " & Format(Shp.Width / X, "0.00") & " cm = " & Format(Range("K1").Left / X, "0.00") & " cm" _ ' , vbInformation, UCase("Dimensions de " & Shp.Name) ' 'Set Shp1 = ActiveSheet.Shapes("Rectangle 51") 'Nom du Rectangle 'Shp1.Left = Range("I1").Left / 2 - Shp1.Width - 25 'Distance entre les 2 rectangles ' 'Set Shp1 = ActiveSheet.Shapes("SeancesPlus") 'Nom du Rectangle 'Shp1.Left = Range("I1").Left / 2 + 25 'Distance entre les 2 rectangles 'End Sub...

ric · Accepted Answer

Je me suis trompé de fichier ... en voici quand même une proposition pour le centrage de tes rectangles ... Je regarde l'autre chose aujourd'hui ... Sub CenterHorizontalementRectangle() x = 28.35 'nombre de points dans 1 cm Dim Shp1 As Shape, Shp As Shape, Shp2 As Shape '- Shp.Width Set Shp = ActiveSheet.Shapes("Rectangle 115") 'Nom du Rectangle Set Shp1 = ActiveSheet.Shapes("91") Set shp2 = ActiveSheet.Shapes("Rectangle 114") 'Le domaine à centrer (selon le fichier soumis) de A1:H1 donc i1 dans la macro ' Positionner 1er rectangle Shp.Left = 10 ' 10 représente le déplacement du rectangle vers la droite ' Positionner 3e rectangle shp2.Left = Range("i1").Left - shp2.Width - 10 ' positionner le 3e rectangle en ajoutant le même espace que le 1er avec la bordure gauche de la feuille ' Positionner 2e rectangle entre les 2 autres Shp1.Left = shp2.Left - (Shp.Width + 10) - 5 ' centrer le 2e rentre les deux, -5 pour la moitié du déplacement End Sub ric...