Centre un CommandButton dans une cellule

[Troudz]

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 !

 

[fhoest]

Re : Centre un CommandButton dans une cellule

Bonjour,
tes boutons de commandes sont des activex ou des contrôles formulaires
A+

 

[Troudz]

Re : Centre un CommandButton dans une cellule

Bonsoir fhoest et merci pour ta "pré - réponse"

Ce sont des boutons ActiveX.

 

[mapomme]

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):

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]

Re : Centre un CommandButton dans une cellule

Bonsoir.
Pour ma part j'utilise très fréquemment cette vieille procédure :

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]

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:

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 😀

A+

 

[Troudz]

Re : Centre un CommandButton dans une cellule

Bonjour mapomme, Danreb et fhoest et un grand merci pour vos réponse qui correspondent parfaitement à ce dont j'avais besoin.

Bonne journée à vous 3 !