Align images center in all worksheets

[Ash k]

Hi All,

I have the code that loops through all my worksheets and resizes all the images but is there anyway to make it so that the images also align center within the cell?

Sub ChangeAllPics()
Dim s As Shape
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
For Each s In ws.Shapes
s.LockAspectRatio = msoFalse
s.Width = 62
s.Height = 63
Next s
Next ws
End Sub

Would appreciate the help!

 

[sxhall]

When the file is generated it is adding the pictures in to it in the correct order then?

So if I get the active row for each image and then centre it it should leave the images in the corrrect order. Will see if I can update the code later.

The code I wrote previously had no order specified which will explain why it is putting htem in the order it is as it is working htrough the order in the selection pane.

 

[sxhall]

OK had a quick look as it wasn't too bad to fix!

The below looks at the row that a shape is in and then uses that to row number to centre on. This will mean that image 170 will stay in the row it is in but be centred in the designated column (changed to 'C' in the below).

Just a word of warning to detect the row it references the top left corner of the image so if it is marginally in to the row above by a single pixel(!) it will use this as the row. Looking at your image you should be OK with the below, fingers crossed.

Sub ChangeAllPics3()

'Will align pictures in cells in a column
'Added in to detect image row number to centre on the row it is in
'Does not follow selection pane order

Dim s As Shape
Dim ws As Worksheet
Dim ColWidth As Single
Dim RowHeight As Single
Dim AlignCol As String

Dim RowCounter As Integer
Dim ShpNumber As Integer

AlignCol = "C"

For Each ws In ActiveWorkbook.Worksheets

    For Each s In ws.Shapes
   
        ShpNumber = Right(s.Name, Len(s.Name) - 6)
        RowCounter = s.TopLeftCell.Row
     
        ColWidth = Range(AlignCol & RowCounter).Offset(0, 1).Left - Range(AlignCol & RowCounter).Left
        RowHeight = Range(AlignCol & RowCounter).Offset(1, 0).Top - Range(AlignCol & RowCounter).Top
   
        ws.Shapes.Range(Array("Image " & ShpNumber)).Select
   
        With ws.Shapes.Range(Array("Image " & ShpNumber))
            .LockAspectRatio = msoFalse
            .Width = 65
            .Height = 65
            .Left = (Range(AlignCol & RowCounter).Left + (ColWidth / 2)) - (s.Width / 2)
            .Top = (Range(AlignCol & RowCounter).Top + (RowHeight / 2)) - (s.Height / 2)
        End With

        RowCounter = RowCounter + 1
       
    Next s
   
Next
   
End Sub

My before - showing the images in an order different to the selection pane order...

My after - showing the images in the same order as before but centred in column G of thier respective rows...

 

[sxhall]

Couldn't edit the above posts code but the below has an update to allow for the column to be a varying width across the sheets just in case they vary.

Sub ChangeAllPics3()

'Will align pictures in cells in a column
'Added in to detect image row number to centre on the row it is in
'Does not follow selection pane order

Dim s As Shape
Dim ws As Worksheet
Dim ColWidth As Single
Dim RowHeight As Single
Dim AlignCol As String

Dim RowCounter As Integer
Dim ShpNumber As Integer

For Each ws In ActiveWorkbook.Worksheets

AlignCol = "C"

    For Each s In ws.Shapes

        ShpNumber = Right(s.Name, Len(s.Name) - 6)
        RowCounter = s.TopLeftCell.Row
        
        ColWidth = ws.Range(AlignCol & RowCounter).Offset(0, 1).Left - ws.Range(AlignCol & RowCounter).Left
        RowHeight = ws.Range(AlignCol & RowCounter).Offset(1, 0).Top - ws.Range(AlignCol & RowCounter).Top
    
        ws.Shapes.Range(Array("Image " & ShpNumber)).Select
    
        With ws.Shapes.Range(Array("Image " & ShpNumber))
            .LockAspectRatio = msoFalse
            .Width = 65
            .Height = 65
            .Left = (Range(AlignCol & RowCounter).Left + (ColWidth / 2)) - (s.Width / 2)
            .Top = (Range(AlignCol & RowCounter).Top + (RowHeight / 2)) - (s.Height / 2)
        End With

        RowCounter = RowCounter + 1
        
    Next s
    
Next
    
End Sub

 

[RoryA]

A reminder:

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at:

Align images centrally in their cell (for all the worksheets)

I have the code that loops through all my worksheets and resizes all the images but is there anyway to make it so that the images also align center within their cells? Sub ChangeAllPics() Dim s As ...

stackoverflow.com

There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.