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]

Hi Ash K,

Code below will align all images centre with the centre of cell 'G4'.

Sub ChangeAllPics()

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

For Each ws In ActiveWorkbook.Worksheets

    For Each s In ws.Shapes
    
    ColWidth = Range("G4").Offset(0, 1).Left - Range("G4").Left
    RowHeight = Range("G4").Offset(1, 0).Top - Range("G4").Top
    
    s.LockAspectRatio = msoFalse
    s.Width = 65
    s.Height = 65
    s.Left = (Range("G4").Left + (ColWidth / 2)) - (s.Width / 2)
    s.Top = (Range("G4").Top + (RowHeight / 2)) - (s.Height / 2)
    
    Next s

Next

End Sub

Or... do you need to align images to the centre of different cells? See my image below.

This code will align each image in to the next cell of a given column.

In the code below change where I have 'G' to the column you need and the start row (4 below) to the first row to align the picture to. Example below starts in cell 'G4' and then goes to the next row for each sheet.

Sub ChangeAllPics2()

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

AlignCol = "G" 'Change 'G' to column needed

For Each ws In ActiveWorkbook.Worksheets

Counter = 4 'Start row number, change '4' to the row to start at 

    For Each s In ws.Shapes
    ColWidth = Range(AlignCol & Counter).Offset(0, 1).Left - Range(AlignCol & Counter).Left
    RowHeight = Range(AlignCol & Counter).Offset(1, 0).Top - Range(AlignCol & Counter).Top
    
    s.LockAspectRatio = msoFalse
    s.Width = 65
    s.Height = 65
    s.Left = (Range(AlignCol & Counter).Left + (ColWidth / 2)) - (s.Width / 2)
    s.Top = (Range(AlignCol & Counter).Top + (RowHeight / 2)) - (s.Height / 2)
    
    Counter = Counter + 1
    
    Next s
    
Next
    
End Sub

 

[Ash k]

Thanks! the second one works great, I just tweaked it slightly to fit my sheets and good to go!

 

[Ash k]

Hi Ash K,

Code below will align all images centre with the centre of cell 'G4'.

Sub ChangeAllPics()

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

For Each ws In ActiveWorkbook.Worksheets

    For Each s In ws.Shapes
   
    ColWidth = Range("G4").Offset(0, 1).Left - Range("G4").Left
    RowHeight = Range("G4").Offset(1, 0).Top - Range("G4").Top
   
    s.LockAspectRatio = msoFalse
    s.Width = 65
    s.Height = 65
    s.Left = (Range("G4").Left + (ColWidth / 2)) - (s.Width / 2)
    s.Top = (Range("G4").Top + (RowHeight / 2)) - (s.Height / 2)
   
    Next s

Next

End Sub

Or... do you need to align images to the centre of different cells? See my image below.

View attachment 116175

This code will align each image in to the next cell of a given column.

In the code below change where I have 'G' to the column you need and the start row (4 below) to the first row to align the picture to. Example below starts in cell 'G4' and then goes to the next row for each sheet.

Sub ChangeAllPics2()

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

AlignCol = "G" 'Change 'G' to column needed

For Each ws In ActiveWorkbook.Worksheets

Counter = 4 'Start row number, change '4' to the row to start at

    For Each s In ws.Shapes
    ColWidth = Range(AlignCol & Counter).Offset(0, 1).Left - Range(AlignCol & Counter).Left
    RowHeight = Range(AlignCol & Counter).Offset(1, 0).Top - Range(AlignCol & Counter).Top
   
    s.LockAspectRatio = msoFalse
    s.Width = 65
    s.Height = 65
    s.Left = (Range(AlignCol & Counter).Left + (ColWidth / 2)) - (s.Width / 2)
    s.Top = (Range(AlignCol & Counter).Top + (RowHeight / 2)) - (s.Height / 2)
   
    Counter = Counter + 1
   
    Next s
   
Next
   
End Sub

Hii, circling back here, I noticed that the pictures get aligned around the first 16 rows but then the images and rows start getting mixed up. Do you know if there could be a specific reason here, perhaps something I am doing wrong?

 

[sxhall]

Hii, circling back here, I noticed that the pictures get aligned around the first 16 rows but then the images and rows start getting mixed up. Do you know if there could be a specific reason here, perhaps something I am doing wrong?

Just ran a test and it orders the images in the order they appear in the 'layers' of the worksheet! Using the selection pane I can see that it starts at the bottom of the list and works up based on this order. Moving shapes up or down in this list affects the order.

In my test it finds Rectangle1 first and then goes to rectangle3 next...

Do you have a consistant naming convention i.e. Image1, image2 etc? If so then I could add a count in to select them which would get around the above.

 

[Ash k]

Just ran a test and it orders the images in the order they appear in the 'layers' of the worksheet! Using the selection pane I can see that it starts at the bottom of the list and works up based on this order. Moving shapes up or down in this list affects the order.

In my test it finds Rectangle1 first and then goes to rectangle3 next...
View attachment 116247

View attachment 116248

Do you have a consistant naming convention i.e. Image1, image2 etc? If so then I could add a count in to select them which would get around the above.

The images are named as 1,2,3 but it does not follow per which rows they are in. So picture 60 is in row 5

 

[sxhall]

The images are named as 1,2,3 but it does not follow per which rows they are in. So picture 60 is in row 5


View attachment 116249

OK, so they should be in the respective rows...

Image 5 should be in row 5, image 60 should be in row 60 etc?

If there is an image missing e.g. there is no image 44, should it leave row 44 empty or use it for the next image?

If so I'll update the code to order them correctly.

 

[Ash k]

OK, so they should be in the respective rows...

Image 5 should be in row 5, image 60 should be in row 60 etc?

If there is an image missing e.g. there is no image 44, should it leave row 44 empty or use it for the next image?

If so I'll update the code to order them correctly.

The pictures are in the correct rows already as they are with the right article names/codes, so I would not want the image to move around but just resize in the row that they are already assigned to.


If there is an image missing, then there would be no need for any thing to be centered, as long as it does not mess up the rest of the images.

Thank you again for the help!

 

[sxhall]

Think I've misunderstood your reply...

I noticed that the pictures get aligned around the first 16 rows but then the images and rows start getting mixed up. Do you know if there could be a specific reason here, perhaps something I am doing wrong?

Can you add an image and highlight the problem?

 

[Ash k]

Think I've misunderstood your reply...



Can you add an image and highlight the problem?

So basically the file that I am working on is generated weekly and the pictures rows and picture number do not match (this is fine because they are still in the right cell and attached to the right article no. that I need it to be attached to). When I run the Macro it rearranges the pictures to match the rows that the picture number has.

For example: Picture 170 is in row 4 but when I run the macro, picture 170 moves to row 170.

I hope that I somehow explained that correctly