Consulting

Results 1 to 4 of 4

Thread: Position Object

  1. #1

    Cool Position Object

    Please help to create following macro.......

    I need macro coding to copy position of the autoshape (object) and apply this position to other autoshape.

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,094
    Location
    Quote Originally Posted by marathi.bana
    Please help to create following macro.......

    I need macro coding to copy position of the autoshape (object) and apply this position to other autoshape.
    Not quite sure what you need, maybe this sort of thing ...
    [vba]Sub copy_pos()
    Dim osourceshp As Shape
    Dim otargetshp As Shape
    Set osourceshp = ActivePresentation.Slides(1).Shapes("Rectangle 3")
    Set otargetshp = ActivePresentation.Slides(2).Shapes("Oval 2")
    otargetshp.Left = osourceshp.Left
    otargetshp.Top = osourceshp.Top
    Set osourceshp = Nothing
    Set otargetshp = Nothing
    End Sub[/vba]
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    [quote=marathi.bana]Please help to create following macro.......

    I want macro that will record the position of the one object or autoshape

    and another macro that will apply that recorded position on other object or autoshape

  4. #4
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,094
    Location
    [quote=marathi.bana]
    Quote Originally Posted by marathi.bana
    Please help to create following macro.......

    I want macro that will record the position of the one object or autoshape

    and another macro that will apply that recorded position on other object or autoshape
    Thats what the code above does, maybe this is more what you imagined

    [vba]Public sngleft As Single
    Public sngtop As Single
    Sub pickup()
    If ActiveWindow.Selection.Type <> ppSelectionShapes Then Exit Sub
    With ActiveWindow.Selection.ShapeRange(1)
    sngleft = .Left
    sngtop = .Top
    End With
    End Sub
    Sub apply()
    If ActiveWindow.Selection.Type <> ppSelectionShapes Then Exit Sub
    With ActiveWindow.Selection.ShapeRange(1)
    .Left = sngleft
    .Top = sngtop
    End With
    End Sub[/vba]

    Select a shape > run pickup and then select another shape and run apply
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •