PDA

View Full Version : [SOLVED] Align all shapes to the center of their cell



nugol
04-27-2016, 01:47 AM
Hy,

I try to align all shapes in my workbook to the center of their respective cell.
I found a solution to align one selected shape and I know how to select all shapes of a workbook.

But I don't get how to align all selected shapes.

That is the solution for aligning one selected shapes.


Sub pictest()
Dim vSel As Variant
Dim rngZ As Range
Set vSel = Selection
If VarType(vSel) = vbObject Then
With vSel
Set rngZ = .TopLeftCell
.Top = rngZ.Top + (rngZ.Height - .Height) / 2
.Left = rngZ.Left + (rngZ.Width - .Width) / 2
.ShapeRange.LockAspectRatio = -1
.Placement = xlMoveAndSize
.PrintObject = True
End With
rngZ.Select
End If
End Sub

So any ideas? Thx in advance

nugol
04-27-2016, 04:49 AM
So, got it now.


Sub piccenter()
Dim Row As Integer
Dim Shp As Shape
For Each Shp In ActiveSheet.Shapes
Shp.Select

Dim vSel As Variant
Dim rngZ As Range
Set vSel = Selection
If VarType(vSel) = vbObject Then
With vSel
Set rngZ = .TopLeftCell
.Top = rngZ.Top + (rngZ.Height - .Height) / 2
.Left = rngZ.Left + (rngZ.Width - .Width) / 2
.ShapeRange.LockAspectRatio = -1
.Placement = xlMoveAndSize
.PrintObject = True
End With
rngZ.Select
End If
Next
End Sub