Restricted randomization of slide order

[Aschrum]

Hi,

I want to randomize the order of all slides of a presentation except the two first and two last slides. Those which shall be rearranged contain pictures and related text.
Additionally I'd like to select a limited batch of the slides containing pictures for the randomization. I.e. there could be 20 slides with pictures and the presentation should show only five of them in a random order.

I am a beginner in terms of vba. For that reason I've tried to google fitting pieces of code.

Regarding the first issue:
This one works fine for randomization of the whole presentation but so far I didn't find out how I could limit the effect of the randomization.


Sub sort_rand()

Dim i As Integer
Dim myvalue As Integer
Dim islides As Integer
islides = ActivePresentation.Slides.Count
For i = 1 To ActivePresentation.Slides.Count
myvalue = Int((i * Rnd) + 1)
ActiveWindow.ViewType = ppViewSlideSorter
ActivePresentation.Slides(myvalue).Select
ActiveWindow.Selection.Cut
ActivePresentation.Slides(islides - 1).Select
ActiveWindow.View.Paste
Next

End Sub

Another code I found that might fit into the above is the following.

For i = 1 To ActivePresentation.Selection.SlideRange.Count
strSel = strSel & CStr(ActiveWindow.Selection.SlideRange(i).SlideIndex) '( & vbCrLf)


Can any one tell me how this problem could be solved?

I am using Office 2007.

Greets,
André

[John Wilson]

This page on our site shows how to do this (scroll down) http://www.pptalchemy.co.uk/vbasamples.html

It's hardly ever a good idea to select in PowerPoint vba BTW.

[Aschrum]

Thanks John, this one made it.
So the first issue is solved.


Sub shufflerange()
Dim Iupper As Integer
Dim Ilower As Integer
Dim Ifrom As Integer
Dim Ito As Integer
Dim i As Integer
Iupper = ActivePresentation.Slides.Count - 2
Ilower = 3
For i = 1 To 2 * Iupper
Randomize
Ifrom = Int((Iupper - Ilower + 1) * Rnd + Ilower)
Ito = Int((Iupper - Ilower + 1) * Rnd + Ilower)
ActivePresentation.Slides(Ifrom).MoveTo (Ito)
Next i 'for-Schleife = Umsortierung
'Exit Sub
End Sub

What's the use of "Exit Sub" here?

Is there any way to "select" only a limited bunch of slides?
Maybe invisibling some slides respectively making only a few (like the two first, two last and five in between visible?

[John Wilson]

In your code exit sub does nothing

In my original code it jumped out of the subroutine BEFORE the error message (which only shows when there is an error)

You cannot make a slide invisible but you can set it to HIDDEN so that it desn't play in the slide show
e.g.
ActivePresentation.Slides(1).SlideShowTransition.Hidden = msoTrue

[Aschrum]

Is that a capable solution in your opinion or would there be another/better way to "select" a specified amount of slides?


In my original code it jumped out of the subroutine BEFORE the error message (which only shows when there is an error)


I see.

André

[John Wilson]

You should attempt to never actually select slides. Usually there is no need and the code will run much faster.

To hide a range of slides:

ActivePresentation.Slides.Range(Array(2, 4, 6)).SlideShowTransition.Hidden = True

You can use the same method to move slides to the end

ActivePresentation.Slides.Range(Array(2, 4, 6)).MoveTo ActivePresentation.Slides.Count

[Aschrum]

Hi John,

regarding the speed it should be much faster to "select"/hide the slides in front of the randomization, right? Cause there would be i.e. 20 slides instead of 60 to sort.

I dont really get how arrays work.
This one doesn't work [Slides (unknown member): Invalid request. Presentation contains no slides.] Anyways this would be a bad solution cause I'd need in in the way of your code with variables (like Iupper).

Dim MyArray(5 To 56) As Variant
ActivePresentation.Slides.Range(MyArray).SlideShowTransition.Hidden = True

For the following it says it needs a changeless expression instead of the variable Iupper.



Dim Ilowerhidden As Integer
Ilowerhidden = 3
Dim MyArray(Ilowerhidden To Iupper) As Variant


Another useful code snippet I found:


Dim PPT As Object
Dim Pres As Object
On Error Resume Next
Set PPT = CreateObject("PowerPoint.Application")
Set Pres = PPT.Presentations.Open(FileName:="C:\Documents and Settings\StuhrmannA\Desktop\E-Learning\Makro\makro5.pptm", ReadOnly:=False, Untitled:=False, WithWindow:=False)
If Pres.SlideShowWindow Is Nothing Then
Pres.SlideShowSettings.Run
End If


But for some reason it opens the slide view twice. Any suggestions?

[John Wilson]

Array can be difficult to understand

In the usual use:

Dim myArray(1 to 5) as Long for eaxample

Creates an array with 5 "spaces" for values BUT they are empty there is no data.

You have to add the data

MyArray(1)=6 for example adds the value 6 in the first "space"

If you want an array that has a variable number of spaces (ie NOT a "changeless expression") (Constant I guess)

First Dim with no spaces

Dim MyArray() as Variant

then
iUpper=whatever
ReDim MyArray(1 to iUpper)

[Aschrum]

You are right, should've been "constant".
That issue seems to be fixed.

Still doesn't work anyways.
It still shows "Slides (unknown member): Invalid request. Presentation contains no slides" related to the last line of code. :think:


Iupper = ActivePresentation.Slides.Count - 2
...
Dim MyArray() As Variant
Dim Ilowerhidden As Integer
Ilowerhidden = 8
ReDim MyArray(Ilowerhidden To Iupper)

ActivePresentation.Slides.Range(MyArray).SlideShowTransition.Hidden = True

Btw: I'm using the randomization, hiding and autostart of the slide show within one sub. Is there any reason to do different?

[John Wilson]

That's because you still haven't added any VALUES to the array so the presentaion is trying to hide nothing.

Sub hidesome()
Dim MyArray() As Long
Dim Ilower As Integer
Dim Inumber As Integer
Dim Icount As Integer
Ilower = 2
Inumber = 4 '4 slides starting with 2 (ie slides 2,3,4,5)
ReDim MyArray(1 To Inumber) 'you have made the spaces
'NOW fill them with the values
For Icount = 0 To Inumber - 1
MyArray(Icount+1) = Ilower + Icount
Next Icount
ActivePresentation.Slides.Range(MyArray).SlideShowTransition.Hidden = True
End Sub

[Aschrum]

Thank you very much John! :)

This snippet works fine:


Dim MyArray() As Variant
Dim Inumber As Integer
Dim Icount As Integer
Dim Ilowerhidden As Integer

Inumber = Iupper Iupper - 7 '7=5 slides with pictures + 2 introducing slides
Ilowerhidden = 8

ReDim MyArray(1 To Inumber)

For Icount = 0 To Inumber - 1
MyArray(Icount + 1) = Ilowerhidden + Icount
Next Icount

ActivePresentation.Slides.Range(MyArray).SlideShowTransition.Hidden = True


The following is to make all slides visible:

Sub showslides()
Dim MyArray() As Long
Dim Ilower As Integer
Dim Inumber As Integer
Dim Icount As Integer

Ilower = 1
Inumber = ActivePresentation.Slides.Count

ReDim MyArray(1 To Inumber)

For Icount = 0 To Inumber - 1
MyArray(Icount + 1) = Ilower + Icount
Next Icount

ActivePresentation.Slides.Range(MyArray).SlideShowTransition.Hidden = False

End Sub


Can you also help me with the issue in #7, twice opening of the slide show?
[slide VIEW was wrong in that posting]
The only reason I imagined so far is that the if loop might be too fast. For that reason it would "run" the slide show again cause it didn't run/open fast enough the first time?!

[John Wilson]

I'm only guessing but since you already (I presume) have PowerPoint open you shouldn't create a new instance or declare PPT and Pres as objects. Delete all in Bold

Dim PPT As Object
Dim Pres As Object
On Error Resume Next
Set PPT = CreateObject("PowerPoint.Application")
Set Pres = PPT.Presentations.Open(FileName:="C:\Documents and Settings\StuhrmannA\Desktop\E-Learning\Makro\makro5.pptm", ReadOnly:=False, Untitled:=False, WithWindow:=False)
If Pres.SlideShowWindow Is Nothing Then
Pres.SlideShowSettings.Run
End If
If that doesn't help post ALL of the code

[Aschrum]

First: "Delete all in bold." In the end: "post all code". Means I shall post nothing? :think::giggle

Doesn't make sense to delete the first line cause "pres" is used in the others.


Dim Pres As Object
Set Pres = Presentations.Open(FileName:="...", ReadOnly:=False, Untitled:=False, WithWindow:=False)
Pres.SlideShowSettings.Run


Even like this it runs two slide shows. :wot

The rest of the code isn't related to the running. It's only the randomization and hiding.

[John Wilson]

You should declare Pres as Presentation not Object but here there's no way I ever see two shows. set PPT=CreateObject(PowerPoint.Application) will create a second instance of PowerPoint though did you delete that line and also Dim PPT as Object? Removing the On Error line may help you spot any errors. I think I'd set WithWindow to True BTW though again it doesn't give me two shows.

If you can post a sample somewhere or email to johnATSIGNHEREpptalchemy.co.uk I can have a look (replace ATSIGNHERE with @)

[Aschrum]

Just in case someone has the same problem:


Sub runpres()
Dim Pres As Presentation
ActiveWindow.WindowState = ppWindowMinimized 'This isn't required for the code to work
Set Pres = ActivePresentation
Pres.SlideShowSettings.Run
End Sub