• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Center Images in Excel column and Resize them

zz_zz

New Member
Hi all! My first post here.

I am trying to center images in Column E and resize them to take about 90% of the cell but have padding around it. I found this VBA below from @jolivanes. It works great but I am not sure how I can resize images. Any help would be appreciated.

>>> use code - tags <<<
Code:
Sub Maybe()
Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        If shp.TopLeftCell.Column = 5 Then
            With shp
                .Top = Range(shp.TopLeftCell.Address).Top + ((Range(shp.TopLeftCell.Address).Height - shp.Height) / 2)
                .Left = Range(shp.TopLeftCell.Address).Left + ((Range(shp.TopLeftCell.Address).Width - shp.Width) / 2)
            End With
        End If
    Next shp
End Sub
 
Last edited by a moderator:
1. Is the 90% for height and width of the cell's size?
2. If you change both height and width uniformly, you could be changing the aspect ratio.

That same thing goes for the usual qoal which is to resize to the full cell's height and width. Aspect ratio changes can distort an image.
 
1. Is the 90% for height and width of the cell's size?
2. If you change both height and width uniformly, you could be changing the aspect ratio.

That same thing goes for the usual qoal which is to resize to the full cell's height and width. Aspect ratio changes can distort an image.

90% of the height of the cell
 
Here is the 90% of row height for you. Be sure to test on backup copy.
Code:
Sub Maybe()
  Dim shp As Shape, tlc As Range
  For Each shp In ActiveSheet.Shapes
    Set tlc = shp.TopLeftCell
    If tlc.Column = 5 Then
      With shp
        .Height = 0.9 * tlc.RowHeight
        .Top = tlc.Top + (tlc.RowHeight - .Height) / 2
        .Left = tlc.Left + (tlc.Width - .Width) / 2
      End With
    End If
  Next shp
End Sub
 
Here is the 90% of row height for you. Be sure to test on backup copy.
Code:
Sub Maybe()
  Dim shp As Shape, tlc As Range
  For Each shp In ActiveSheet.Shapes
    Set tlc = shp.TopLeftCell
    If tlc.Column = 5 Then
      With shp
        .Height = 0.9 * tlc.RowHeight
        .Top = tlc.Top + (tlc.RowHeight - .Height) / 2
        .Left = tlc.Left + (tlc.Width - .Width) / 2
      End With
    End If
  Next shp
End Sub

Thank you so much! Works great
 
Back
Top