VBA to move 1st shape(?) down & right a bit

[Robie]

Hi

I know about Word VBA but not much for PowerPoint. I am not sure this will be possible but thought I would ask anyway.

We have a presentation created few years ago (244 pages) and since then we have moved on to 2010 templates and new themes. Quite simply, I would like the content of the old presentation brought into the latest themed presentation but look right.

Applying the new theme sort of works but not for everything. The 1st shape(?)/box is overwriting the company name and some other stuff. Moving the shape/box for each slide (all 244 of it) is not something I want to do. So, is it possible to write some VBA to move the 1st shape/box down & right a bit? Perhaps, I can then use it to move other stuff as well (if required.

Thank you so much - whatever the response.

The two screen are as follows (before with new theme applied already and after):

56Before.png

57After.png

[HansV]

Could you do the following? Thanks in advance!

- Select the box you want to move on any of the slides.
- Press Alt+F11 to activate the Visual Basic Editor.
- Press Ctrl+G to activate the Immediate window.
- Type or copy/paste the following, then press Enter:

Code: Select all

? ActiveWindow.Selection.ShapeRange.Name

- Report the name that you see in a reply here.
- Repeat for the same box on another slide. Do you see the same name, or does it differ from slide to slide?

[Rudi]

    
Here is my attempt to move the title....
I extracted parts of code from various samples from the web and tested this. I don't understand the slide references but it moves the title in my brief tests.
Copy the code, and paste it into a module in the VB Editor. Then run it on a copy of your presentation.
Also, edit the indicated values to determine distance from top and left.

Code: Select all

Sub MoveTitle()
    Dim pres As Presentation
    Dim sld As Slide

    Set pres = ActivePresentation
    For Each sld In pres.Slides.Range
    On Error Resume Next
        If sld.Shapes(1).PlaceholderFormat.Type = ppPlaceholderCenterTitle Or _
            sld.Shapes(1).PlaceholderFormat.Type = ppPlaceholderTitle Then
            If sld.Shapes.Title.TextFrame.TextRange <> "" Then
                sld.Shapes.Title.Top = 50 '< Modify the value to determine distance from top of slide
                sld.Shapes.Title.Left = 50 '< Modify the value to determine distance from left of slide
            End If
        End If
    Next sld
End Sub

[Robie]

Could you do the following? Thanks in advance!

- Select the box you want to move on any of the slides.
- Press Alt+F11 to activate the Visual Basic Editor.
- Press Ctrl+G to activate the Immediate window.
- Type or copy/paste the following, then press Enter:

Code: Select all

? ActiveWindow.Selection.ShapeRange.Name

- Report the name that you see in a reply here.
- Repeat for the same box on another slide. Do you see the same name, or does it differ from slide to slide?

Thanks Hans.
I have done as you ask. I tried about 6 different slides and it seems to alternate between 2 & 8 (for four of them it was 2 and for the other two it was 8).

[HansV]

Do you mean that the names were "2" and "8"?

[Robie]

Do you mean that the names were "2" and "8"?

Yup. That's what it came up when using your vba code.

[HansV]

Try Rudi's code or the following - use a copy of the presentation for testing first!

Code: Select all

Sub MoveBox()
    Dim i As Long
    Dim shp As Shape
    For i = 2 To ActivePresentation.Slides.Count
        For Each shp In ActivePresentation.Slides(i).Shapes
            If shp.HasTextFrame Then
                If shp.TextFrame.TextRange.Text = "Trade Reporting" Then
                    shp.Left = 72
                    shp.Top = 72
                End If
            End If
        Next shp
    Next i
End Sub

As with Rudi's code, adjust the numbers for Left and Top. They are in points, where 1 inch = 72 points.

[Robie]

Thank you so much for looking in to Rudi and Hans.

I will try out both solutions.

[PJ_in_FL]

May want to consider changing the text search to use the .Find function to create a TextRange object. More reliable than checking for specific text... See the modified code below from Hans' example:

Code: Select all

Sub MoveBox()
    Dim i As Long
    Dim shp As Shape
    Dim trFoundText As TextRange

    For i = 2 To ActivePresentation.Slides.Count
        For Each shp In ActivePresentation.Slides(i).Shapes
            If shp.HasTextFrame Then
                 Set trFoundText = shp.TextFrame.TextRange.Find("Trade Reporting")
                 If Not (trFoundText Is Nothing) Then
                    shp.Left = 72
                    shp.Top = 72
                End If
            End If
        Next shp
    Next i
End Sub

I've found PowerPoint is NOT VBA friendly, so anything that makes the code more robust is a good thing!

[HansV]

Thanks, PJ. I'm not very familiar with PowerPoint VBA.