Centrer image dans cellules

Bonjours,

Je cherche un code pour centrer des images dans les cellules de la colonnes "G"

Je joint mon fichier pour explication

Je vous remercie de votre aide

Cordialement

Max

Bonjour

Tu vas trouver le bon truc (3ème post que tu ouvres pour des images)

A essayer

Bonjour Banzai

Nickel je te remercie ainsi que pour les cellules en rouge et te souhaite une bonne soirée.

@+

Max

Bonjour

Suite au code de Banzai64 que je remercie et salut au passage, j'ai un petit souci lorsque je supprime des drapeaux, j'ai un message d'erreur en sachant que je peut avoir 10 pays comme 350 pays suivant le nombre nécessaires

"L"élément portant ce nom est introuvable" sur la ligne

  Set Sh = ActiveSheet.Shapes(Range("H" & J))

Je vous remercie de votre aide

Cordialement

Max

bonjour,

une proposition de solution

Sub Centre()
Dim J As Long
Dim Gauche As Double, Haut As Double, Largeur As Double, Hauteur As Double
Dim Sh As Shape
  On Error GoTo labas
  Application.ScreenUpdating = False
  For J = 5 To Range("H" & Rows.Count).End(xlUp).Row
    Set Sh = ActiveSheet.Shapes(Range("H" & J))
    With Range("G" & J)
      Sh.Left = .Left + (.Width / 2) - (Sh.Width / 2)
      Sh.Top = .Top + (.Height / 2) - (Sh.Height / 2)
    End With
ici:
  Next J
  Application.ScreenUpdating = True
  End
labas:
  Resume ici
End Sub

Bonjour h2so4

Je te remercie beaucoup et te souhaite un bon après midi

Max

Bonjour,

Je voudrais juste que toute mes images de ma colonne "B" soit centrer.

j'ai essayé de modifier la formule un peu plus haut mais sans succès. Pouvez -vous m'aider?

Sub Centre()

Dim J As Long

Dim Gauche As Double, Haut As Double, Largeur As Double, Hauteur As Double

Dim Sh As Shape

On Error GoTo labas

Application.ScreenUpdating = False

For J = 5 To Range("H" & Rows.Count).End(xlUp).Row

Set Sh = ActiveSheet.Shapes(Range("H" & J))

With Range("B" & J)

Sh.Left = .Left + (.Width / 2) - (Sh.Width / 2)

Sh.Top = .Top + (.Height / 2) - (Sh.Height / 2)

End With

ici:

Next J

Application.ScreenUpdating = True

End

labas:

Resume ici

End Sub

h2so4 a écrit :

bonjour,

une proposition de solution

Sub Centre()
Dim J As Long
Dim Gauche As Double, Haut As Double, Largeur As Double, Hauteur As Double
Dim Sh As Shape
  On Error GoTo labas
  Application.ScreenUpdating = False
  For J = 5 To Range("H" & Rows.Count).End(xlUp).Row
    Set Sh = ActiveSheet.Shapes(Range("H" & J))
    With Range("G" & J)
      Sh.Left = .Left + (.Width / 2) - (Sh.Width / 2)
      Sh.Top = .Top + (.Height / 2) - (Sh.Height / 2)
    End With
ici:
  Next J
  Application.ScreenUpdating = True
  End
labas:
  Resume ici
End Sub

Bonjour,

des images sont en colonne H mais tu fais le centrage en colonne G. adapte l'un ou l'autre.

Merci pour ton retour, je viens de trouver mon soucis. Bonne journée

h2so4 a écrit :

Bonjour,

des images sont en colonne H mais tu fais le centrage en colonne G. adapte l'un ou l'autre.

Bonjour

Concernant le centrage des images , je n'arrive pas à l'adapter pour la colonne B

je vous en remercie d'avance pour votre aide

Code: Tout sélectionner

Sub Centre()

Dim J As Long

Dim Gauche As Double, Haut As Double, Largeur As Double, Hauteur As Double

Dim Sh As Shape

On Error GoTo labas

Application.ScreenUpdating = False

For J = 5 To Range("H" & Rows.Count).End(xlUp).Row

Set Sh = ActiveSheet.Shapes(Range("H" & J))

With Range("G" & J)

Sh.Left = .Left + (.Width / 2) - (Sh.Width / 2)

Sh.Top = .Top + (.Height / 2) - (Sh.Height / 2)

End With

ici:

Next J

Application.ScreenUpdating = True

End

labas:

Resume ici

End Sub

bonjour,

un code qui prend toutes les images qui se trouvent sur la feuille et les mets centrées en colonne B,

Sub Centre()
    Dim J As Long
    Dim Gauche As Double, Haut As Double, Largeur As Double, Hauteur As Double
    Dim Sh As Shape
    Application.ScreenUpdating = False
    For Each Sh In ActiveSheet.Shapes
        J = J + 1
        With Range("B" & J)
            Sh.Left = .Left + (.Width / 2) - (Sh.Width / 2)
            Sh.Top = .Top + (.Height / 2) - (Sh.Height / 2)
        End With
    Next
End Sub