Center a graphic in an excel cell

[ChrisCana]

I am working on a product comparison matrix with features in a column and the column next to it will have check marks - I am using imported .jpgs for the check marks, but I can not get them to center in a cell. They don't align like text.

Is there any way, code or otherwise, to get a graphic to center in a cell?

 

[mouthpear]

Doesn't it do both?

Yes it does both, but I am asking about is, if it can be a choice to do both, or just Vertical, or just Horizontal using a message box. "Vertical OR Horizontal OR Both". Notice the "OR"s are capitalized to draw attention to the what I am asking.

 

[Jon Peltier]

Of course it can be tailored to do one or the other or both. You need to figure out how you're asking the user what they want, and how you're taking their answer and running the relevant lines of code.

 

[mouthpear]

Of course it can be tailored to do one or the other or both. You need to figure out how you're asking the user what they want, and how you're taking their answer and running the relevant lines of code.

Well then let me ask it this way. HOW can this be modified to do Vertical OR Horizontal OR Both. Like with a message box that allows you to check mark a box for Vertical, Horizontal. You see I am the user and that what I am trying to find out. How? How is it done?

 

[Jon Peltier]

Here's one way. I made it a little more flexible so that you can select one or more shapes that you want aligned, and the routine will align all selected shapes within the range they cover. The shapes may be positioned within a single cell or may overlap several shapes. The code finds the underlying range based on the top-left cell and bottom-right cell under the shape.

I made a UserForm F_AlignSelectedShapes with two checkboxes, chkHorizontal and chkVertical, both checked by default. The UserForm has two buttons, btnOK and btnCancel. The Default property of btnOK is True, so pressing Enter is the same as clicking btnOK. The Cancel property of btnCancel is True, so pressing Esc is the same as clicking btnCancel.

The code in the UserForm module is simple:

Option Explicit

Private Sub btnOK_Click()
  ' loop through all selected shapes
  Dim shp As Shape
  For Each shp In Selection.ShapeRange
    Dim TopLeftCell As Range, BottomRightCell As Range
    Set TopLeftCell = shp.TopLeftCell
    Set BottomRightCell = shp.BottomRightCell
    Dim UnderlyingGrid As Range
    Set UnderlyingGrid = Range(TopLeftCell, BottomRightCell)
    
    If Me.chkHorizontal.Value Then
      shp.Left = UnderlyingGrid.Left + (UnderlyingGrid.Width - shp.Width) / 2
    End If
    
    If Me.chkVertical.Value Then
      shp.Top = UnderlyingGrid.Top + (UnderlyingGrid.Height - shp.Height) / 2
    End If
  Next
 
  Unload Me
End Sub

Private Sub btnCancel_Click()
  Unload Me
End Sub

I also have code in a regular code module that checks whether one or more shapes are selected, and if so, it displays the UserForm.

Option Explicit

Sub AlignSelectedShapesInGrid()
  On Error Resume Next
  Dim shprng As ShapeRange
  Set shprng = Selection.ShapeRange
  On Error GoTo 0
  If Not shprng Is Nothing Then
    F_AlignSelectedShapes.Show
  End If
End Sub

In the left image you see two selected shapes in their original misaligned positions and the UserForm. In the right image you see the images in their center-aligned positions.

 

[mouthpear]

Here's one way. I made it a little more flexible so that you can select one or more shapes that you want aligned, and the routine will align all selected shapes within the range they cover. The shapes may be positioned within a single cell or may overlap several shapes. The code finds the underlying range based on the top-left cell and bottom-right cell under the shape.

I made a UserForm F_AlignSelectedShapes with two checkboxes, chkHorizontal and chkVertical, both checked by default. The UserForm has two buttons, btnOK and btnCancel. The Default property of btnOK is True, so pressing Enter is the same as clicking btnOK. The Cancel property of btnCancel is True, so pressing Esc is the same as clicking btnCancel.

The code in the UserForm module is simple:

Option Explicit

Private Sub btnOK_Click()
  ' loop through all selected shapes
  Dim shp As Shape
  For Each shp In Selection.ShapeRange
    Dim TopLeftCell As Range, BottomRightCell As Range
    Set TopLeftCell = shp.TopLeftCell
    Set BottomRightCell = shp.BottomRightCell
    Dim UnderlyingGrid As Range
    Set UnderlyingGrid = Range(TopLeftCell, BottomRightCell)
  
    If Me.chkHorizontal.Value Then
      shp.Left = UnderlyingGrid.Left + (UnderlyingGrid.Width - shp.Width) / 2
    End If
  
    If Me.chkVertical.Value Then
      shp.Top = UnderlyingGrid.Top + (UnderlyingGrid.Height - shp.Height) / 2
    End If
  Next
 
  Unload Me
End Sub

Private Sub btnCancel_Click()
  Unload Me
End Sub

I also have code in a regular code module that checks whether one or more shapes are selected, and if so, it displays the UserForm.

Option Explicit

Sub AlignSelectedShapesInGrid()
  On Error Resume Next
  Dim shprng As ShapeRange
  Set shprng = Selection.ShapeRange
  On Error GoTo 0
  If Not shprng Is Nothing Then
    F_AlignSelectedShapes.Show
  End If
End Sub

In the left image you see two selected shapes in their original misaligned positions and the UserForm. In the right image you see the images in their center-aligned positions.

View attachment 63549

NICE! I like this a lot. I like that you can select specific shapes however I have around 30 images that need to be aligned. The first code would let me select a cell and the images inside that cell. So I need to be to select all the images in a range first and included .MergeArea for the merged cells. I ended up with this.

Option Explicit

Private Sub btnOK_Click()
    ' loop through all selected shapes
   
    Dim shp    As Shape
    For Each shp In Selection.ShapeRange
       
        Dim TopLeftCell As Range, BottomRightCell As Range
        Set TopLeftCell = shp.TopLeftCell.MergeArea
        Set BottomRightCell = shp.BottomRightCell.MergeArea
        Dim UnderlyingGrid As Range
        Set UnderlyingGrid = Range(TopLeftCell, BottomRightCell)
       
        If Me.chkHorizontal.Value Then
            shp.Left = UnderlyingGrid.Left + (UnderlyingGrid.Width - shp.Width) / 2
        End If
       
        If Me.chkVertical.Value Then
            shp.Top = UnderlyingGrid.Top + (UnderlyingGrid.Height - shp.Height) / 2
        End If
    Next
   
    Unload Me
End Sub

Private Sub btnCancel_Click()
    Unload Me
End Sub

Sub AlignSelectedShapesInGrid()
    Application.Run "SelectAllPicturesInSelectedRange"
    On Error Resume Next
    Dim shprng As ShapeRange
    Set shprng = Selection.ShapeRange
    On Error GoTo 0
    If Not shprng Is Nothing Then
        F_AlignSelectedShapes.Show
    End If
End Sub
Sub SelectAllPicturesInSelectedRange()

    Dim oShape As Shape
    Dim rUserSel As Range

    If TypeName(Selection) <> "Range" Then Exit Sub
   
    Set rUserSel = Selection
   
    For Each oShape In ActiveSheet.Shapes
        If oShape.Type = msoPicture Then
            If Not Intersect(oShape.TopLeftCell, rUserSel) Is Nothing Then
                oShape.Select False
            End If
        End If
    Next oShape
   
End Sub

Now it works great. This way I can select all the images in a range separately or with your code. It also works if individual images are selected first or if you select a range. Now If I can bother you for one more thing. Can and how to streamline this further? TY for your help so far.

 

[PK_1]

Hi all,

First of all thanks for this solution it is great.

I am new to macros so please bear with me. I am making a table for people to fill in, and i want it to work so that when people type in the cell in column C, if the text is bigger than the cell is automatically increases the row height. i can do this easily enough, but in column A there is a picture, and i want this to automatically move to the centre of the cell when the row height is changed.

I have followed these steps and i can get it to work when I manually run the macro. Is there a way to have this work automatically whenever the row height is changed?

As in the picture most of the cells aren't a problem but the "features" field can spill over, any more text in that cell will increase the height of row 10, but i don't want the users of this workbook to have to run a macro every time this happens.

Any help would be greatly appreciated.

 

[Jon Peltier]

The last code I posted works on any selected shapes/pictures. You can do the whole sheet by selecting one shape, pressing Ctrl+A which will select all shapes, then running the code.

To do a single shape, select it and run the code.

To do a small number of shapes, select one then hold Ctrl while you select the rest, then run the code.