I want to make a macro for PowerPoint, to generate a custom show, containing all the slides from my PowerPoint but in random order.
How would I do this?
I want to be able to run it and create different custom shows each time.
It's been 3 years since I used PowerPoint, and the only experience I have with VB was a little bit of VB6 in 2004.
Check out the info here.
Sample:
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
Related
Is there a way in VBA to select all the slides in active ppt doc that use a given custom layout?
CustomLayout.Name=”1_separator”
CustomLayout.Index=”1”
So far, I have played with this idea:
For Each CustomLayout In ActivePresentation.SlideMaster.CustomLayouts
If CustomLayout.Name = "1_Separator" Then
ActivePresentation.Slides.Range.Select
Exit For
End If
Next
End Sub
However, it selects all the slides in the ppt (not only the ones with ”1_separator”), so it is not what I need.
My overall aim is to create an automated Table of Contents in ppt, for that I would like to choose particular slides with macro.
Alternatively, I could put a shape or specific text box on the slides, based on which I am going to create a Table of Contents.But I don’t know the code for selecting slides with a given shape or text, either.
I will be grateful for any help on this.
Sub SelectSlidesWithGivenCustomLayout()
Dim slidesToSelect(999)
Dim currentSlide As Slide
Dim counter As Integer
counter = 0
For Each currentSlide In ActivePresentation.Slides
If currentSlide.CustomLayout.Name = "1_Separator" Then
slidesToSelect(counter) = currentSlide.SlideIndex
counter = counter + 1
End If
Next
ActivePresentation.Slides.Range(slidesToSelect).Select
End Sub
I was reading up on the use of Shape.DrawSpline Method (Visio) from MS office VBA reference. The example they gave works when I entered it within Visio. The example takes points and connect them with a curve and display it in the Visio application.
I wish to have the VBA code reside within MS Access and I will have VBA code open a Visio drawing, and execute the Shape.DrawSpline Method from MS Access VBA code. My problem seems to determine how to generate the expression shape to get the program to run and draw the sample curve in the open Visio drawing.
Here is the code I was working on, and the part that opens up a Visio drawing is working for me:
Dim AppVisio As Visio.Application
Dim ShpObj As Visio.Shape
Dim XYPoints(70) As Double
Set AppVisio = CreateObject("Visio.Application")
Set DocObj = AppVisio.Documents.Open("C:\Test Template.vsd")
When I command MS Access to execute the above code, the Visio Drawing "Test Template.vsd" does open it.
Immediately following the above code, I have the x, y coordinates of the points to be ploted. They are assigned to the XYPoints array.
At the bottom, I have the following code which was used to execute the DrawSpline Method (Visio) from MS Access VBA code.
Here is that code:
Set ShpObj = AppVisio.Application.ActivePage.DrawSpline(XYPoints, 0.25, visSplinePeriodic)
I get an error in the above statement. Here is the error I get:
"Run-time error '-2032465751 (86db08a9)'
Method 'DrawSpline' of object 'IVPage' failed
Thank You,
I agrree with #y4cine's advice. However my guess is either your document isn't opening correctly, or your populating of your points array isn't in the correct format. The following adaptation of the SDK sample works for me:
Sub TestSplineFromExcel()
Dim vApp As Visio.Application
Set vApp = CreateObject("Visio.Application")
Dim intCounter As Integer
Dim XYPoints(1 To (5 * 2)) As Double
For intCounter = 1 To 5
'Set x components (array elements 1,3,5,7,9) to 1,2,3,4,5
XYPoints((intCounter * 2) - 1) = intCounter
'Set y components (array elements 2,4,6,8,10) to f(i)
XYPoints(intCounter * 2) = (intCounter * intCounter) - (7 * intCounter) + 15
Next intCounter
vApp.Documents.Add ""
Dim vPag As Visio.Page
Set vPag = vApp.ActivePage
If vPag Is Nothing Then
MsgBox "Target page is null"
Else
Dim shp As Visio.Shape
Set shp = vPag.DrawSpline(XYPoints, 0.25, Visio.VisDrawSplineFlags.visSplinePeriodic)
End If
End Sub
I just started using VBA a few days ago. I noticed that some few commands do not seem to work on my computer and I was wondering whether this is due to my computer setup.
I am using VBA in PowerPoint 2013 on Windows 7 run via VMware Fusion (virtual machine) on MacOSX. I need to create a dynamic reference to the active slide, but several way of doing so broke my code:
Set oSl = Application.ActiveWindow.View.Slide
(as suggested here)
Set oSl = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideNumber)
(as suggested here)
Set oSl = ActiveWindow.Selection.SlideRange.SlideIndex
(as suggested here)
None of these worked for me. Since I just started using VBA I simply inserted Message Boxes after different parts of the code, and looked at when the boxes where no longer triggered - in this case always after the "oSl =" line that I replaced with the various other approaches delineated above. Additionally,
Set oSl = ActiveWindow.Selection.SlideRange(1)
also broke my code (as discussed here)
What DID work so far was
Set oSl = ActivePresentation.SlideS(1)
All the methods above that didn't work (but should) contain "ActiveWindow". It would be great if you could advise on whether there are errors in my approach to selecting the active slide or whether the issue might be that VBA can't access the "ActiveWindow" properly because my PowerPoint runs on a virtual machine. Should that be the case, is there another way to select the currently active slide without using ActiveWindow?
EDIT: I am trying to apply this to the following code in PowerPoint. Basically what I want to do is replace the line "oSl = ActivePresentation.SlideS(1)" with a line of code that won't always target slide 1 but whichever slide is currently active. My question is not so much HOW to do this - there are plenty of instructions on how to do it online. My question is WHY these approaches are not working for me.
Sub SelectionMacro()
Dim oSl As Slide
Dim oSh As Shape
Dim aArrayOfShapes() As Variant
Dim ShapeX As Shape
Dim N As Long
Dim Temp As Variant
Dim J As Long
Dim FadeEffect As Effect
Set oSl = ActivePresentation.SlideS(1)
'This section creates an array of all pictures on Slide1 called
'"aArrayOfShapes"
For Each oSh In oSl.Shapes
If oSh.Type = msoPicture Then
On Error Resume Next
Debug.Print UBound(aArrayOfShapes)
If Err.Number = 0 Then
ReDim Preserve aArrayOfShapes(1 To UBound(aArrayOfShapes) + 1)
Else
ReDim Preserve aArrayOfShapes(1 To 1)
End If
Set aArrayOfShapes(UBound(aArrayOfShapes)) = oSh
End If
Next
'This section creates a random index number within the bounds of the
'length of aArrayOfShapes and assigns the shape with that index number
'to the Shape object ShapeX
Randomize
NumberX = Int((UBound(aArrayOfShapes) - (LBound(aArrayOfShapes) - 1)) * Rnd) + LBound(aArrayOfShapes)
Set ShapeX = aArrayOfShapes(NumberX)
'This section shuffles aArrayOfShapes
For N = LBound(aArrayOfShapes) To UBound(aArrayOfShapes)
J = CLng(((UBound(aArrayOfShapes) - N) * Rnd) + N)
If N <> J Then
Set Temp = aArrayOfShapes(N)
Set aArrayOfShapes(N) = aArrayOfShapes(J)
Set aArrayOfShapes(J) = Temp
End If
Next N
'This section loops through all Shapes in aArrayOfShapes and
'fades them out one by one EXCEPT for ShapeX
For Each Shape In aArrayOfShapes
If ShapeX.Name <> Shape.Name Then
Set FadeEffect = oSl.TimeLine.MainSequence.AddEffect _
(Shape:=Shape, effectid:=msoAnimEffectFade, trigger:=msoAnimTriggerAfterPrevious)
With FadeEffect
.Timing.Duration = 0.5
.Exit = msoTrue
End With
End If
Next Shape
End Sub
I had similar problem.
Try to replace:
ActiveWindow.View.Slide.SlideNumber
with:
ActivePresentation.SlideShowWindow.View.Slide.SlideIndex
It was what I needed in my project, maybe it helps you.
This is my first question, so sorry for terminology.
I'm beginner in VBA, so I'm stopped in few questions.
I'm working in Powerpoint. I have combobox and I want to add items from table (it could be as table, or Excel spreadSheet) which is on previous slide.
I found one example for Excel (I don't know if will work in PPT):
Sub Loadbox()
row_review = 1
Dim TheSheet As ?????
Set TheSheet = ?????
Do
DoEvents
row_review = row_review + 1
item_in_review = TheSheet.Range("A" & row_review)
If Len(item_inreview) > 0 Then ComboBox1.AddItem (item_in_review)
Loop Until item_in_review = ""
End Sub
But I couldn't understand how to define table from witch I get data for item.
Maybe there is better way how to do it?
To read the contents of the first cells of a row in a PowerPoint table this is the starting point.
Dim tbl As Table
Dim i As Long
Set tbl = ActivePresentation.Slides(1).Shapes(2).Table
For i = 1 To tbl.Rows.Count
Debug.Print tbl.Cell(i, 1).Shape.TextFrame2.TextRange.Text
Next
I have the following VBA code in Powerpoint 2010 to pick a name from a list at random:
Dim hat As New Collection
Sub fill_the_hat()
Dim items() As String
Dim x As Long
items = Split("Test\Names\John\Bob\Chris\Mike\Robert\Adam", "\")
For x = 0 To UBound(items)
hat.Add(items(x))
Next x
End Sub
Sub pick_one()
Dim x As Long
Randomize
x = Int(Rnd * hat.Count) + 1
MsgBox hat(x)
hat.Remove (x)
End Sub
I need to adapt this to output to a text box rather than a MsgBox but this doesn't seem as obvious as I thought it would be?
Any help would be greatly appreciated,
Many Thanks,
Josh
You will have to adress your UserForm and TextBox directly to change the contents. An example would be:
UserForm1.TextBox1.Text = x
This has to happen before the UserForm1.Show call or alternatively you have to refresh the form via UserForm1.Repaint
If you are just displaying the name there is no need at all to use an ActivX textbox. Just use a normal shape or textbox
ActivePresenation.Slides(1).Shapes ("nameofshape").Textframe.TextRange=hat(x)
Also when you use my code from the net it is more normal to say "I got this code from John Wilson's article here" rather that "I have this code"