magnel
05-06-2014, 01:06 AM
Hi John,
Using the similar fashion below, please help me with a code that can pickup location or position of any object on the ppt slide and apply that to another object on the same slide or any other slide.
Dim adj() As Single
Sub PickUp_Ang_Adj()
Dim oshp As Shape
Dim i As Integer
On Error Goto err:
Set oshp = ActiveWindow.Selection.ShapeRange(1)
Redim adj(1 To oshp.Adjustments.Count)
For i = 1 To oshp.Adjustments.Count
adj(i) = oshp.Adjustments(i)
Next i
Exit Sub
err:
MsgBox "Select Shape"
End Sub
Sub Apply_Ang_Adj()
Dim oshp As Shape
Dim i As Integer
On Error Goto err:
For Each oshp In ActiveWindow.Selection.ShapeRange
Redim Preserve adj(1 To oshp.Adjustments.Count)
For i = 1 To oshp.Adjustments.Count
oshp.Adjustments(i) = adj(i)
Next i
Next oshp
Exit Sub
err:
MsgBox "ERROR"
End Sub
- Thanks
Using the similar fashion below, please help me with a code that can pickup location or position of any object on the ppt slide and apply that to another object on the same slide or any other slide.
Dim adj() As Single
Sub PickUp_Ang_Adj()
Dim oshp As Shape
Dim i As Integer
On Error Goto err:
Set oshp = ActiveWindow.Selection.ShapeRange(1)
Redim adj(1 To oshp.Adjustments.Count)
For i = 1 To oshp.Adjustments.Count
adj(i) = oshp.Adjustments(i)
Next i
Exit Sub
err:
MsgBox "Select Shape"
End Sub
Sub Apply_Ang_Adj()
Dim oshp As Shape
Dim i As Integer
On Error Goto err:
For Each oshp In ActiveWindow.Selection.ShapeRange
Redim Preserve adj(1 To oshp.Adjustments.Count)
For i = 1 To oshp.Adjustments.Count
oshp.Adjustments(i) = adj(i)
Next i
Next oshp
Exit Sub
err:
MsgBox "ERROR"
End Sub
- Thanks