VBA programming

[alves]

Hi all,

A not so easy question...

I was given a set of 358 slides for a course I have to teach... The
slides are a disaster! in terms of colors, fonts, text position
etc....

Rather than using the default boxes for the title and text (which
would allow me to easily change the presentation) the person who
created the slides added 1 extra box for the slide title and another
for the slide text...

Can you please help me doing a code that for all slides will :
1) delete a symbol that was added to every slide (not in the master
slide)
2) delete a box that has the exact same text in all slides (name of
the course)
3) identify the two boxes with text and the one with mode characters
will copy paste to the default slide text box and the one with less
characters will be copied to the default slide title box.

Hope this is not impossible!

Thanks in advance.

PA

 

[David Marcovitz]

Do you have any coding experience? I can help get you started, but I
don't have time to write and test all the code. You could start with
something like this (untested air code):

Sub DeleteStuff()
Dim i As Long
Dim oSld As Slide

For Each oSld in ActivePresentation.Slides
For i = oSld.Shapes.Count To 1
With oSld.Shapes(i)
If .HasTexFrame Then
If .Text = "That stupid title that you want to delete"
oShp.Delete
Else
'If that symbol is a character in a text box,
'do something to delete it here
End If
Else
'If that symbol is a picture and you have some way of
'identifying it, do something to delete it here
End If
End With
Next i
Next oSld
End Sub

The other part (#3) is doable as well, but would take a little more
code. If you are a coder, this might get you started. If you are not,
you might want to hire one.

--David

 

[John Wilson]

This code should sort #2

Sub zap()
Dim osld As Slide
Dim i As Integer
For Each osld In ActivePresentation.Slides
For i = osld.Shapes.Count To 1 Step -1
If osld.Shapes(i).TextFrame.TextRange = "Whatever" Then _
osld.Shapes(i).Delete
Next i
Next osld
End Sub

For the others it would help to know:

Version of PPT
Is the symbol at exactly the same position on every slide
Does it have the same name or some other identifying feature

 

[PA]

Thanks a lot for your quick replies.

I am using PPT 2007

I am Ok with coding, I use excel VBA very often, but I am new to
Powerpoint... So I basically need some help handling the shapes.

I tried something like this:
Sub Delete_textbox()
Dim sld As Slide
Dim shp As Shape
For Each sld In ActivePresentation.Slides
If sld.SlideIndex <> 1 Then
For Each shp In sld.Shapes
If shp.HasTexFrame Then
If shp.Text = "XXXXXX" Then
shp.Delete
End If
End If
Next shp
End If
Next sld
End Sub

but it always gets stuck in HasTexFrame ... David's code also gets
stuck in the same property.

As to the solution presented by John, it returns an out of range
error...in the line If osld.Shapes(i).TextFrame.TextRange =
"Whatever" Then

Must be a silly error on my side.

As to the picture the only way to identify it is the position... it is
always in the same spot! top left cornet with exact same position.

Finally to copy the text I was thinking on something like this... but
no idea on handling shape text

Sub copytext()
Dim sld As Slide
Dim shp As Shape
For Each sld In ActivePresentation.Slides
'After deleting the other 2 shapes, 99% of the slides have 4
shapes with text 2 empty (default title and text) and the 2 created by
the user
'if number shapes = 4
'cShape1 = VBA commands to extract the text from the
shape that is not the default title or the default text
'cShape2 = VBA commands to extract the text from the
shape that is not the default title or the default text

' some ifs here to identify the longest one

'default slide title shape text = paste text from
smallest cShapex
default slide text shape text = paste text from
smallest cShapex
'end if
Next sld
End Sub


Thanks again.

 

[David Marcovitz]

I told you it was air code. That should be HasTextFrame, it is checking
to see if the shape actually has text before it tries to figure out if
the text is the right text. Also, I forgot "Step -1" on my For i = ...
line. Oops, I also for the the .TextFrame.TextRange.Text instead of just
..Text (sorry, I was really in a hurry).

As for John's solution, his solution is the same as mine except he
missed the HasTextFrame stuff to make sure that the shape has a text
frame before comparing the text to something.

For the picture, since it is in the same spot, you can have your If
statement be something like:

If oShp.Top = 42 AND oShp.Left = 27 Then
oShp.Delete
End If

For the copy, you can get the text from shape oShp with

oShp.TextFrame.TextRange.Text

Sorry, I have to get back to work. I hope this helps. Sorry about the
poor air code from earlier.

--David

 

[John Wilson]

Mine was air code too and it definitely needs the textframe check!

Here's the new code


Sub zap()
Dim osld As Slide
Dim i As Integer
For Each osld In ActivePresentation.Slides
For i = osld.Shapes.Count To 1 Step -1
If osld.Shapes(i).HasTextFrame Then
If osld.Shapes(i).TextFrame.TextRange = "Whatever" Then _
osld.Shapes(i).Delete
End If
Next i
For i = osld.Shapes.Count To 1 Step -1
If osld.Shapes(i).Left = 27 And osld.Shapes(i).Top = 42 Then _
osld.Shapes(i).Delete
Next i
Next osld
End Sub


Note it itterates backwards through the shapes - here's why

Suppose you have 4 shapes and itterate forwards
If you delete shape 2, shape 3 becomes 2 and 4 becomes 3
The code will not check the new shape 2 (it did that already on its view)
AND when it gets to i=4 it's going to say "Where's 4" only not so nicely"!

Are you SURE the shape is exactly at 42/27?

If it's just close you could try some fuzzy logic
eg
If Abs(27 - osld.Shapes(i).Left) < 2 ...

All of this is still air code but I'm awake now!
--
john ATSIGN PPTAlchemy.co.uk
Custom vba coding and PPT Makeovers
Free PPT Hints, Tips and Tutorials
http://www.pptalchemy.co.uk/powerpoint_hints_and_tips_tutorials.html

 

[PA]

Done!!!! Thanks a million for the help. I could not have done it
without it.

PA

 

[John Wilson]

Like it!
--
john ATSIGN PPTAlchemy.co.uk
Custom vba coding and PPT Makeovers
Free PPT Hints, Tips and Tutorials
http://www.pptalchemy.co.uk/powerpoint_hints_and_tips_tutorials.html