creating a macro to create slides with Numbers

[childofsai]

I want to create a macro within powerpoint that will create slides with data
taken from a userform listbox. i.e. userform has a list of 2,3,4,9 -- I would
like to then have 8 slides automatically created with:

2,
<blank slide>,
3
<blank slide>,
4,
<blank slide>,
9

This "seems" simple, so I have starting to try and write this myself, but I
would appreciate some help. My knowledge of VBA is basic and I only learnt it
through Excel.

regards,

ChildOfSai

 

[David Marcovitz]

If you go to my site (http://www.PowerfulPowerPoint.com/), you can look
at Example 7.9 (click on Examples by Chapter) to see an example of
adding a slide. The PrintablePage procedure adds a slide and adjusts the
text on the slide. As for the UserForm, I'm not quite sure what you are
getting at. Will the user be entering specific numbers, or will you want
to create the slide from all the choices that are there?
--David

 

[childofsai]

For some reason I can't reply to Steve, so I'll reply this to David's thread.

In the interest of trying to learn how to do this myself, here's the code
I've written so far:


Function IsOdd(x As Integer) As Boolean
IsOdd = (x Mod 2) <> 0
End Function

Sub Numbers()

Dim SlideCount As Integer

For SlideCount = 2 To SlideCount = 40

If IsOdd(SlideCount) Then
ActivePresentation.Slides.Add(Index:=SlideCount,
Layout:=ppLayoutText).Select
ActiveWindow.Selection.SlideRange.Shapes("Rectangle 2").Select
ActiveWindow.Selection.ShapeRange.Delete
ActiveWindow.Selection.SlideRange.Shapes("Rectangle 3").Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select

ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Paragraphs(Start:=1,
Length:=1).ParagraphFormat.Alignment = ppAlignCenter

ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Paragraphs(Start:=1,
Length:=1).ParagraphFormat.Bullet.Visible = msoFalse

ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1,
Length:=0).Select
With ActiveWindow.Selection.TextRange
.Text = "126"
With .Font
.Name = "Arial"
.Size = 227
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
End With

Else
ActivePresentation.Slides.Add(Index:=SlideCount,
Layout:=ppLayoutText).Select
ActiveWindow.Selection.SlideRange.Shapes("Rectangle 2").Select
ActiveWindow.Selection.ShapeRange.Delete
ActiveWindow.Selection.SlideRange.Shapes("Rectangle 3").Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select

ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Paragraphs(Start:=1,
Length:=1).ParagraphFormat.Alignment = ppAlignCenter

ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Paragraphs(Start:=1,
Length:=1).ParagraphFormat.Bullet.Visible = msoFalse

ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1,
Length:=0).Select
With ActiveWindow.Selection.TextRange
.Text = ""
With .Font
.Name = "Arial"
.Size = 227
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
End With
End If
Exit For
Next

End Sub


Presently I am writing the "Numbers" program to do the following:

- to repeated create slides that have the above formatting and text settings
(black background, 227 font size, centered text)
- for the even numbered slides, the slide should have the text "126" -->
This is arbitrary for now. Later I would like for these values to be taken
from a UserForm where a list of numbers are input.
- For the odd numbers, the text value would be blank.

Let's start there for now.... (-__-)

Regards,

ChildOfSai

 

[childofsai]

Thanks a lot Steve.

Could you give me some guidance as to how to make the userform to store a
list of numbers? -- Should I be using ListBox or TextBox?

I've created the basic layout of the userform and then I wrote a macro to
show it, so I could see how it is working so far, but this didn't seem to
work:

Sub FrmNumbers()
FrmNumbers.Show
End Sub

Could you show me what I'm doing wrong?

Regards,

childofsai

 

[childofsai]

Hi Steve,

The whole idea is that the user would have a userform popup with some sort
of input box that would allow them to put in a list of numbers like so:

4,9,20,145

-or-

4
9
20
145

These values are then stored in some way and used to create a list of
slides, using the below code. For each of the numbers, there would be a blank
slide following it.

I hope that explains it.

Regards,

childofsai

 

[childofsai]

Some more googling and fiddling, and I came up with more code to do
completely what I wanted the PPT to do.

I put a command button on a slide, which loaded the UserForm. The Userform
then had a textbox, in which I input a comma seperated string of numbers.
Clicking ok would hopefully send the string split up into an array and then
call the main Numbers sub:


Private Sub cmdOK_Click()

Dim myStr As String

myStr = CStr(txtInputBox.Value)
Call Numbers

End Sub

I then edited the main sub as such:

Sub Numbers()

Dim SlideCount As Integer
Dim oSl As Slide
Dim oSh As Shape

For SlideCount = 2 To (2 * (UBound(Split(myStr)) + 1)) ' this should
give the correct number of slides - i.e. 2 times the number of values in the
string
Set oSl = ActivePresentation.Slides.Add(Index:=SlideCount, _
Layout:=ppLayoutText)
With oSl
.Shapes("Rectangle 2").Delete
Set oSh = .Shapes("Rectangle 3")

With oSh.TextFrame.TextRange
.Paragraphs(Start:=1, _
Length:=1).ParagraphFormat.Alignment = ppAlignCenter
.Paragraphs(Start:=1, _
Length:=1).ParagraphFormat.Bullet.Visible = msoFalse

If IsOdd(SlideCount) Then
.Text = Split(myStr, ",")((SlideCount / 2) - 1) 'This
would hopefully pull from the string array for each value, seperated by the
comma
Else
.Text = ""
End If

With .Font
.Name = "Arial"
.Size = 227
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
End With ' Osh
End With ' oSl
Next

End Sub

this however doesn't work >_<

Am I right in my reasoning?

Regards,

childofsai

 

[childofsai]

I DID IT!

(I'm so proud of myself).

I made the myStr variable Public and switched round the If statement for the
"IsOdd" text and it's working now

Now how do I set the slides to be black background and white text, when they
are created?

regards,

childofsai

 

[David Marcovitz]

That's great! To set the fill color of a slide to Black, you could use:

oSl.Background.Fill.ForeColor.RGB = RGB(0, 0, 0)

To set a shapes text to be white, you could use

oSh.TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)

--David

 

[childofsai]

I think I'd prefer to write it all in the code, rather than have another
external file to worry about.

I've tried the 2 codes lines you mentioned. I put each line after "Set oSl"
and "Set oSh".

I didn't see the formatting change. Is this because my first slide is in
white BG/black text?

Also, I'd like to increase the text size, but that makes the text
off-centre. Is there a way to set the textbox to a centre position of the
slide? Otherwise, how can I utilise something like "Top Increment"?

Regards,

childofsai

 

[childofsai]

[ snipping away all the old stuff ]

Good Idea ^_^.

Here's the current code:

FrmNumbers:
--------------
Option Explicit

Private Sub cmdCancel_Click()

Unload Me

End Sub

Private Sub cmdOK_Click()

myStr = txtInputBox.Text

Call Numbers

Unload Me

End Sub


ModNumbers:
---------------
Public myStr As String

Function IsOdd(x As Integer) As Boolean
IsOdd = (x Mod 2) <> 0
End Function

Sub Numbers()

Dim SlideCount As Integer
Dim oSl As Slide
Dim oSh As Shape

For SlideCount = 2 To ((2 * (UBound(Split(myStr, ",")) + 1)) + 1)
Set oSl = ActivePresentation.Slides.Add(Index:=SlideCount, _
Layout:=ppLayoutText)
With oSl
.Shapes("Rectangle 2").Delete
.Background.Fill.ForeColor.RGB = RGB(0, 0, 0)
Set oSh = .Shapes("Rectangle 3")

With oSh.TextFrame.TextRange
.Font.Color.RGB = RGB(255, 255, 255)
.Paragraphs(Start:=1, _
Length:=1).ParagraphFormat.Alignment = ppAlignCenter
.Paragraphs(Start:=1, _
Length:=1).ParagraphFormat.Bullet.Visible = msoFalse

If IsOdd(SlideCount) Then
.Text = ""
Else
.Text = Split(myStr, ",")((SlideCount / 2) - 1)
End If

With .Font
.Name = "Arial"
.Size = 227
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
End With ' Osh
End With ' oSl
Next

End Sub

***************************

Regards,

childofsai

 

[childofsai]

Thanks so much for your help Steve!

I believe I should now be able to clean the rest of this up.

Now how do I put a green tick on this thread...

Regards,

childofsai

[ snipping away all the old stuff ]

Good Idea ^_^.

And back to you, modified. No changes to anything else but Sub
Numbers.

You might also want to either delete all rectangles and add your own
new one centered top to bottom on the slide or center the shape that
you're already using.

Sub Numbers()

Dim SlideCount As Integer
Dim oSl As Slide
Dim oSh As Shape

' rather than mess with a form, I'm just plugging
' values into the string here for test porpoises.
' ignore this
'myStr = "3,5,8,11,44,99,22,33"

For SlideCount = 2 To ((2 * (UBound(Split(myStr, ",")) + 1)) + 1)
Set oSl = ActivePresentation.Slides.Add(Index:=SlideCount, _
Layout:=ppLayoutText)
With oSl
.Shapes("Rectangle 2").Delete
'.Background.Fill.ForeColor.RGB = RGB(0, 0, 0)
' Just stole this from a recorded macro ...
.FollowMasterBackground = msoFalse
.DisplayMasterShapes = msoTrue
With .Background
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Fill.Transparency = 0#
.Fill.Solid
End With

Set oSh = .Shapes("Rectangle 3")

' this should sort out the centering problems
oSh.TextFrame.VerticalAnchor = msoAnchorMiddle
oSh.TextFrame.HorizontalAnchor = msoAnchorCenter

With oSh.TextFrame.TextRange
'.Font.Color.RGB = RGB(255, 255, 255)
.Paragraphs(Start:=1, _
Length:=1).ParagraphFormat.Alignment = ppAlignCenter
.Paragraphs(Start:=1, _
Length:=1).ParagraphFormat.Bullet.Visible = msoFalse

If IsOdd(SlideCount) Then
.Text = ""
Else
.Text = Split(myStr, ",")((SlideCount / 2) - 1)
End If

With .Font
.Name = "Arial"
.Size = 227
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.RGB = RGB(255, 255, 255)
'.Color.SchemeColor = ppForeground
End With
End With ' Osh
End With ' oSl
Next

End Sub

==============================
PPT Frequently Asked Questions
http://www.pptfaq.com/

PPTools add-ins for PowerPoint
http://www.pptools.com/

 

[childofsai]

Oh well. I guess I'll just leave it at that.

Many thanks,

childofsai

Thanks so much for your help Steve!

My pleasure (and David's too, I'm sure).

Now how do I put a green tick on this thread...

First you git yerse'f a green tick hound, name 'im "Ol Green" then you
send 'im out inta the swamp and when he comes back ...

Actually, I've no idea. I don't use the web view. ;-)

Regards,

childofsai

:
[ snipping away all the old stuff ]

Good Idea ^_^.

And back to you, modified. No changes to anything else but Sub
Numbers.

You might also want to either delete all rectangles and add your own
new one centered top to bottom on the slide or center the shape that
you're already using.

Sub Numbers()

Dim SlideCount As Integer
Dim oSl As Slide
Dim oSh As Shape

' rather than mess with a form, I'm just plugging
' values into the string here for test porpoises.
' ignore this
'myStr = "3,5,8,11,44,99,22,33"

For SlideCount = 2 To ((2 * (UBound(Split(myStr, ",")) + 1)) + 1)
Set oSl = ActivePresentation.Slides.Add(Index:=SlideCount, _
Layout:=ppLayoutText)
With oSl
.Shapes("Rectangle 2").Delete
'.Background.Fill.ForeColor.RGB = RGB(0, 0, 0)
' Just stole this from a recorded macro ...
.FollowMasterBackground = msoFalse
.DisplayMasterShapes = msoTrue
With .Background
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Fill.Transparency = 0#
.Fill.Solid
End With

Set oSh = .Shapes("Rectangle 3")

' this should sort out the centering problems
oSh.TextFrame.VerticalAnchor = msoAnchorMiddle
oSh.TextFrame.HorizontalAnchor = msoAnchorCenter

With oSh.TextFrame.TextRange
'.Font.Color.RGB = RGB(255, 255, 255)
.Paragraphs(Start:=1, _
Length:=1).ParagraphFormat.Alignment = ppAlignCenter
.Paragraphs(Start:=1, _
Length:=1).ParagraphFormat.Bullet.Visible = msoFalse

If IsOdd(SlideCount) Then
.Text = ""
Else
.Text = Split(myStr, ",")((SlideCount / 2) - 1)
End If

With .Font
.Name = "Arial"
.Size = 227
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.RGB = RGB(255, 255, 255)
'.Color.SchemeColor = ppForeground
End With
End With ' Osh
End With ' oSl
Next

End Sub

==============================
PPT Frequently Asked Questions
http://www.pptfaq.com/

PPTools add-ins for PowerPoint
http://www.pptools.com/

==============================
PPT Frequently Asked Questions
http://www.pptfaq.com/

PPTools add-ins for PowerPoint
http://www.pptools.com/

 

[David Marcovitz]

Thanks so much for your help Steve!

My pleasure (and David's too, I'm sure).
[/QUOTE]

Yes, sorry, I had to bag out of this thread (and most other newsgroup
posting) for a few days. I had a firm deadline to get my grades in by
3pm yesterday, and I submitted the last batch of grades at 2:45 pm. I
figured you were in good hands with Steve.

--David