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 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
2
Each Shape will have a Shape.TopLeftCell property, which contains the cell that its top-left corner overlaps with.
This cell will then have the Range.Top, Range.Left, Range.Width, and Range.height properties.
(It will also have the Range.MergeArea property, in case a shape sits in a Merged Area instead of a single cell).
Now, to centre a shape in the cell, you want to set the Left of the Shape to the Left of the Cell, plus half the Width of the Cell, minus half the Width of the Shape.
'Cell: | [-------------]
'Shape: |{=======}
'
'Cell Left: |→→→→→→→→→→→→[-------------]
' | {=======}
'
'Plus half Cell Width: | [→→→→→→|------]
' | {=======}
'
'Minus half Shape Width: | [--¦←←←|------]
' | {===¦===}
Then you do the same thing for the Top and Height of the Shape and Cell.
(You are forcing the size of the Shapes to be 62*63, so we could use 31 and 31.5 as our values there — however, for versatility, I am going to avoid that)
Sub ChangeAllPics()
Dim s As Shape, c AS Range
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
Set c = s.TopLeftCell.MergeArea
s.Top = c.Top+(c.Height-s.Height)/2
s.Left = c.Left+(c.Width-s.Width)/2
Set c = Nothing
Next s, ws
End Sub