Sub fixalign2()
Dim oshp1 As Shape
Dim oshp2 As Shape
If ActiveWindow.Selection.ShapeRange.Count <> 2 Then Exit Sub
Set oshp1 = ActiveWindow.Selection.ShapeRange(1)
Set oshp2 = ActiveWindow.Selection.ShapeRange(2)
oshp1.Width = oshp1.Width * 0.3
oshp2.Width = oshp2.Width * 0.3
oshp1.Top = cm2Points(7)
oshp2.Top = cm2Points(7)
oshp2.Left = oshp1.Left + oshp1.Width
'group
ActiveWindow.Selection.ShapeRange.Group.Select
ActiveWindow.Selection.ShapeRange.Left = cm2Points(7)
End Sub
Function cm2Points(inVal As Single) As Single
cm2Points = inVal * 28.346
End Function
|