Try:
Dim sngL As Single
Dim sngT As Single
Dim sngH As Single
Dim sngW As Single
Sub Pick_Up_Format()
'picks up format of selected shape
Dim oshp As Shape
On Error Resume Next
Err.Clear
Set oshp = ActiveWindow.Selection.ShapeRange(1)
If Err <> 0 Then
MsgBox "Select a shape!"
Else
sngL = oshp.Left
sngT = oshp.Top
sngW = oshp.Width
sngH = oshp.Height
oshp.PickUp
End If
End Sub
Sub Apply_Format()
' Apply to all selected shapes
Dim oshp As Shape
On Error Resume Next
Err.Clear
If sngH = 0 And sngW = 0 Then
MsgBox "Pick up format first."
Exit Sub
End If
For Each oshp In ActiveWindow.Selection.ShapeRange
If Err <> 0 Then
MsgBox "Select a shape!"
Else
oshp.Apply
oshp.Left = sngL
oshp.Top = sngT
oshp.Width = sngW
oshp.Height = sngH
End If
Next oshp
End Sub
|