Thread: [Solved] Resize and align
View Single Post
 
Old 11-08-2012, 10:15 AM
JohnWilson JohnWilson is offline Windows 7 64bit Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,914
JohnWilson has a spectacular aura aboutJohnWilson has a spectacular aura about
Default

That should probably be .Height/2??

To get the outline around the box you would need to Cut and paste special as a png then add the outline. I would do this before you position.

If you havent solved it by tomorrow i'll be back! (it's 5 pm here)

here's a start

Code:
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

ActiveWindow.Selection.ShapeRange.Cut
With ActivePresentation.Slides(1).Shapes.PasteSpecial(ppPastePNG)
.Left = cm2Points(7) - .Width / 2
.Top = cm2Points(7) - .Height / 2
.Line.Visible = True
.Line.ForeColor.RGB = RGB(255, 0, 0)
.Line.Weight = 3
End With

End Sub

Function cm2Points(inVal As Single) As Single
cm2Points = inVal * 28.346
End Function
__________________
Microsoft PowerPoint MVP 2007-2023
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote