Centre un CommandButton dans une cellule

Troudz

XLDnaute Occasionnel
Bonsoir tout le monde,

J'ai un grand nombre de CommandButton dans une feuille.
Ces boutons sont tous de taille inférieure à la cellule dans laquelle ils sont placés.
Je voudrais simplement savoir si il existe une macro qui me permette de les centrer automatiquement dans leur cellule ?

Je vous remercie par avance,

Bonne soirée à tous !
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Centre un CommandButton dans une cellule

Bonjour à tous,

Si Les CommandButton sont sur la feuille 'Feuil1', alors on peut essayez ce code (dans le module de code de Feuil1):
VB:
Sub Centrer()
Dim shp, rg As Range
 For Each shp In ActiveSheet.Shapes
  If shp.Name Like "CommandButton*" Then
   Set rg = shp.TopLeftCell
   shp.Left = rg.Left + (rg.Width - shp.Width) / 2
   shp.Top = rg.Top + (rg.Height - shp.Height) / 2
  End If
 Next shp
End Sub
 

Dranreb

XLDnaute Barbatruc
Re : Centre un CommandButton dans une cellule

Bonsoir.
Pour ma part j'utilise très fréquemment cette vieille procédure :
VB:
Sub SelMilieuPlage()
Dim Sh As Object
On Error GoTo Erreur
For Each Sh In Selection.ShapeRange
   ObjMilieuPlage Sh
   Next Sh
Exit Sub
Erreur: Resume AutreEssai
AutreEssai: On Error GoTo 0: Set Sh = Selection: ObjMilieuPlage Sh
End Sub
Sub ObjMilieuPlage(Sh As Object)
Dim Xm As Double, Ym As Double
Dim xG1 As Double, xG2 As Double, Xd1 As Double, Xd2 As Double, xMMei As Double, xMEss As Double
Dim yH1 As Double, yH2 As Double, yB1 As Double, yB2 As Double, yMMei As Double, yMEss As Double
Xm = Sh.Left + Sh.Width / 2: Ym = Sh.Top + Sh.Height / 2
With Sh.TopLeftCell
   xG1 = .Left: xG2 = xG1 + .Width
   yH1 = .Top: yH2 = yH1 + .Height
   End With
With Sh.BottomRightCell
   Xd1 = .Left: Xd2 = Xd1 + .Width
   yB1 = .Top: yB2 = yB1 + .Height
   End With
xMMei = (xG1 + Xd1) / 2
xMEss = (xG1 + Xd2) / 2: If Abs(xMEss - Xm) < Abs(xMMei - Xm) Then xMMei = xMEss
xMEss = (xG2 + Xd1) / 2: If Abs(xMEss - Xm) < Abs(xMMei - Xm) Then xMMei = xMEss
xMEss = (xG2 + Xd2) / 2: If Abs(xMEss - Xm) < Abs(xMMei - Xm) Then xMMei = xMEss
yMMei = (yH1 + yB1) / 2
yMEss = (yH1 + yB2) / 2: If Abs(yMEss - Ym) < Abs(yMMei - Ym) Then yMMei = yMEss
yMEss = (yH2 + yB1) / 2: If Abs(yMEss - Ym) < Abs(yMMei - Ym) Then yMMei = yMEss
yMEss = (yH2 + yB2) / 2: If Abs(yMEss - Ym) < Abs(yMMei - Ym) Then yMMei = yMEss
Sh.Left = xMMei - Sh.Width / 2
Sh.Top = yMMei - Sh.Height / 2
End Sub
Elle peut faire un peu plus que centrer un objet plus petit au milieu de la cellule: elle cherche s'il y a lieu de tenir compte d'éventuelles cellules voisines chevauchée en retenant la solution qui se rapproche le plus de la position actuelle du centre de l'objet.
Cordialement.
 

fhoest

XLDnaute Accro
Re : Centre un CommandButton dans une cellule

Bonjour,
Bien que les solutions sont déjà présentes et qu'elles sont de grande qualités voici ma proposition en retard du fait que je m'étais absenté pour aller faire dodo !!!
Voici la mienne dans le même sens que Mapomme:
Code:
Sub centrage_shapes()
Dim b As Object
Dim x As String
Dim h As Double, w As Double
Dim T As Double, L As Double

For Each b In ActiveSheet.Shapes
  
  x = b.TopLeftCell.Address
  h = Range(x).Height
  w = Range(x).Width
  T = Range(x).Top
  L = Range(x).Left
  
  ActiveSheet.Shapes(b.Name).Top = T + (h - ActiveSheet.Shapes(b.Name).Height) / 2
  ActiveSheet.Shapes(b.Name).Left = L + (w - ActiveSheet.Shapes(b.Name).Width) / 2
  
Next b
  
End Sub

Pas copier mais comme j'avais commencé je voulais finir et pas avoir chercher pour rien, perso je ne choisirais pas ma solution car elles ne gère ni les erreurs ni le type d'objet ,
A toi de voir.

@ Dranreb,et Mapomme Bonjour :D

A+
 

Discussions similaires

Statistiques des forums

Discussions
312 799
Messages
2 092 239
Membres
105 298
dernier inscrit
doudounapnap