As far as I know, the code below gets a shape from the active window, nudges it a bit, copies the slide and pastes it right after the current one, then turns the pasted slide into an active window, and nudges it again:
Sub Test()
' Get the active presentation
Dim oPresentation As Presentation
Set oPresentation = ActivePresentation
' Get the first slide in the presentation
Dim oSlide As Slide
Set oSlide = oPresentation.Slides(1)
' Get the first shape on the slide
Dim oShape As Shape
Set oShape = oSlide.Shapes(1)
' Nudge the shape to the right
oShape.Left = oShape.Left + 1
' Copy the whole slide
oSlide.Copy
' Paste the slide as a new slide at position 2
Dim oNewSlides As SlideRange
Set oNewSlides = oPresentation.Slides.Paste(2)
' Get a reference to the slide we pasted
Dim oNewSlide As Slide
Set oNewSlide = oNewSlides(1)
' Get the first shape on the NEW slide
Dim oNewShape As Shape
Set oNewShape = oNewSlide.Shapes(1)
' Nudge the shape to the right
oNewShape.Left = oNewShape.Left + 1
End Sub
As far as I can understand, in order to implement this code, I should have an active window opened and it should have at least one shape in it. Before I run this code I have only one slide; after the code has been run, I have two slides: the older one is number 1, and the newer one is number 2.
If I run this code one more time, I will get three slides as a result: the oldest one being still number 1, but the oldest one being number 2, not number 3.
My question is how can I make it produce slides, so that the newer slides are always the ones with a greater ordinal number, i.e. every newly created slide should be the last one in the slide preview sidebar (the lowest one)?
And also, how can I make it into a loop? So that I don't need to re-run this code again and again, but simply make a loop with a given number of loop's iterations.
I guess, if it should be a loop, then slides index should be turned into a variable, but I don't know how to do it in PowerPoint VBA.
I'm not sure your code makes any sense. It essentially:
Gets the 1st slide
Gets the 1st shape on the slide
Moves it 1 unit to the right
Copies the 1st slide
Pastes it in as the 2nd slide
Gets the 1st shape on the new 2nd
slide
Moves it 1 unit to the right
Why is it moving it twice, once on the original and once on the copy?
Regardless to answer your specific questions:
To paste it as the last slide, replace
Set oNewSlides = oPresentation.Slides.Paste(2)
With
Set oNewSlides = oPresentation.Slides.Paste() #no index pastes as last
To loop use something like this:
Dim oPresentation As Presentation
Set oPresentation = ActivePresentation
Dim oSlide As Slide
Dim oSlides As SlideRange
Dim oShape As Shape
Dim slideNumber As Integer
For slideNumber = 1 To 10
Set oSlide = oPresentation.Slides(oPresentation.Slides.Count)
oSlide.Copy
Set oNewSlides = oPresentation.Slides.Paste()
Set oSlide = oNewSlides(1)
Set oShape = oSlide.Shapes(1)
oShape.Left = oShape.Left + 5
Next slideNumber
This takes the last slide, copies it, pastes the copy as the new last one, nudges the first shape to the right, takes new last slide, copies it, pastes the copy as the last one, nudges the first shape to the right, etc.... It'll do this 10 times.
Related
I have this PPT vba script to delete all shapes in a region at the bottom left corner of each slide. It works but sometimes it leaves one shape in the area. If I run it again it will get rid of it, but I don't want to have to run it twice! How can I fix this?
Sub GoAwayDumbText()
Dim oPres As Presentation
Dim oSlides As Slides
Dim oSld As Slide
Dim oShp As Shape
Dim PathSep As String
Dim sTempString As String
#If Mac Then
PathSep = ":"
#Else
PathSep = "\"
#End If
Set oPres = ActivePresentation
Set oSlides = oPres.Slides
For Each oSld In oSlides
For Each oShp In oSld.Shapes
If oShp.Left <= 135 And oShp.Top >= 260 Then
oShp.Delete
Else
End If
Next oShp
Next oSld
End Sub
When you're iterating through a collection (shapes, slides, whatever) and deleting items along the way, For/Each loops won't behave as expected.
Instead, use (in this case)
For x = oSld.Shapes.Count to 1 Step -1
Delete from the end of the collection to the beginning rather than from the beginning to the end.
Why?
Suppose you have three items in the collection:
VBA starts with its internal For/Each counter set to 1
First item meets your criteria, you delete it
VBA increments its internal For/Each counter to 2
Since you deleted one item, there are only two items left in the collection, so VBA looks at the second item (which USED TO BE the third item) and deletes it.
VBA increments its internal counter to 3, but you've deleted the first two of three original items, so there's only 1 item in the collection; there's no item three so what used to be item 3 never gets looked at.
[If anyone can offer a better/clearer explanation of this, PLEASE have at it.]
I work from excel, and i open several powerpoint in a loop inside a directory, in vba.
While i run the macro (from excel), I make a loop within every shape inside every slides in powerpoints presentation.
I stop the macro to see if AutoShapeType = -2, and i select it in vba just to check visualy if the shape is the right shape i want.
Otherwise, if the selected shape doesn't seems right, I select it manually and I want to know how the syntaxe to get the id of the current selected shape, in order to name it.
Set PPtapp = CreateObject("Powerpoint.Application")
PPtapp.Visible = True
Dim sld As Slide
Dim numslide As Long
Dim nbslide As Long
Dim WVL_CptShape As Integer
'list of every powerpoint path
ppt = ThisWorkbook.Worksheets("Template").Range("A" & i).Value
For i = 2 To ThisWorkbook.Worksheets("Template").Range("A65536").End(xlUp).Row + 1
Set PptDoc = PPtapp.Presentations.Open(ppt)
With PptDoc
For Each sld In PptDoc.Slides
For WVL_CptShape = 1 To .Slides(sld.SlideNumber).Shapes.Count
WVL_Id = .Slides(sld.SlideNumber).Shapes(WVL_CptShape).ID
If PptDoc.Slides(sld.SlideNumber).Shapes(WVL_CptShape).AutoShapeType = -2 Then
'I select the shape to see visualy if it's a good selection and I stop the macro
PptDoc.Slides(sld.SlideNumber).Shapes(WVL_CptShape).Select
Stop
'if the selection doesnt seems right I select the right shape manualy
'Question : in vba, i want to change the name of the selected shape.
'But i don't know how to get the id of the current selected shape (see below : ID_OF_CURRENT_SHAPE_SELECTED_MANUALY)
'I would like to rename it, in order to recognize it easily next time
PptDoc.Slides(sld.SlideNumber). Shapes(ID_OF_CURRENT_SHAPE_SELECTED_MANUALY).Selection.Name = "Myshape"
end if
Next WVL_CptShapeNext
sld.Close
End With
Next
PPtapp.Quit
Set PPtapp = Nothing
Set PptDoc = PPtapp.Presentations.Open(ppt)
With PptDoc
For Each sld In PptDoc.Slides
For WVL_CptShape = 1 To sld.Shapes.Count
WVL_Id = sld.Shapes(WVL_CptShape).ID
If sld.Shapes(WVL_CptShape).AutoShapeType = -2 Then
'I select the shape to see visualy if it's a good selection and I stop the macro
sld.Shapes(WVL_CptShape).Select
Stop
' And to change the name of the shape:
sld.Shapes(WVL_CptShape).Name = "New name for shape"
' or better, in case you selected a different shape:
ActiveWindow.Selection.ShapeRange(1).Name = "New name for shape"
In this type of situation, you want to work with the shape's Index, not its ID.
Note that you can iterate through the shapes collection on a slide just as you can iterate through the slides collection in a presentation. It makes the code a lot simpler to write and to follow:
Set PptDoc = PPtapp.Presentations.Open(ppt)
With PptDoc
For Each sld In PptDoc.Slides
For each shp in sld.shapes
If shp.AutoShapeType = -2 Then
'I select the shape to see visualy if it's a good selection and I stop the macro
shp.Select
Stop
Let me explain you what I'm trying to do, then I'll explain you where I'm stuck
--> Copy data from Excel table to PowerPoint table (they both have same header), for each row containing data
--> If table in PowerPoint crosses the certain height it should start pasting data on new slide
So, this how I'm approaching:
--> First, considering one slide in ppt as master slide, where table has headers and one blank row below it - I'll copy this slide and paste it when I'll move to next slide
--> copy one row each from Excel and paste it in PowerPoint table
--> if the table in PowerPoint cross the certain height, then paste the new master slide (which I have in copy)
--> this loop should continue for each row in Excel which has data.
I'm approaching to it bit by bit; so far I have created the loop for inserting the row in .ppt table and pasting the slide if it crosses the table height limit. But I'm stuck here - the loop given below insert rows only for master slide and paste the next slide but doesn't insert in other slides.
Public Sub Excel_cpy_pst()
Dim oTbl As Table
Dim mShp As ShapeRange
Dim shp As Object
Dim sldCount As Slide
Set sldCount = ActivePresentation.Slides(ActivePresentation.Slides.Count)
ActivePresentation.Slides(6).Copy 'Copying and using it as a master slide
Set mShp = ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("MyShape"))
Set oTbl = mShp.Table
For Each shp In ActivePresentation.Slides
If mShp.Height <= 6.34 * 72 Then
With oTbl
.Rows.Add (-1) 'adding a row at the bottom of a table
End With
ElseIf ActivePresentation.Slides.Count <= 8 Then 'to stop it from infinite loop, putting a constatnt
With ActivePresentation.Slides
ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1)
End With
End If
Next
End Sub
If you start by duplicating your masterslide you can assign the new slide to a variable that can be referenced.
Dim aSLide as Powerpoint.SlideRange
Set aSlide = .Slides("Slide1").Duplicate
with aSlide
for each shp in aslide.shapes
Add this to your loop to reference the new copy of the original slide.
If your slide template (slide1) is constructed as a table, you can assign the text to each cell in the table then move to the next slide without checking the size. Just fill in the boxes as you go.
Good luck!
I need to be able to copy shapes (chart, table, etc.) programmatically from one slide to another in PowerPoint 2007 keeping their original colors. The source and destination slides are in different presentations which have different themes.
These shapes might be complex and include a lot of colors, e.g., charts, tables, etc. The destination slide must maintain its theme, so I cannot simply copy the entire original slide colorScheme.
When copying a shape manually in PowerPoint, I get an option to "Keep Source Formatting". This copies all the original colors of the shape, converting theme colors into absolute RGB values.
What is the simplest way to do this programmatically?
You need to go to the slide and use Application.CommandBars.ExecuteMso
If you don't need to return to the previously selected slide afterwards, you can skip DoEvents and the second call to Application.CommandBars.ExecuteMso
It seemed like the position of the new shape was sometimes a little bit skewed after pasting, so I obtain a reference to the last shape in the Shapes collection of the second slide and copy the position of the original shape.
At least on my machine, without DoEvents, the macro would do nothing when I executed it (but it would work if I stepped through it).
Sub CopySelectedShapeToNextSlide()
Dim oShape As Shape
Dim oSlide As Slide
Dim nextSlide As Slide
Dim newShape As Shape
Set oShape = Application.ActiveWindow.Selection.ShapeRange(1)
Set oSlide = Application.ActiveWindow.Selection.SlideRange(1)
Set nextSlide = oSlide.Parent.Slides(oSlide.SlideIndex + 1)
oShape.Copy
Application.ActiveWindow.View.GotoSlide nextSlide.SlideIndex
Application.CommandBars.ExecuteMso "PasteSourceFormatting"
Set newShape = nextSlide.Shapes(nextSlide.Shapes.Count)
newShape.Left = oShape.Left
newShape.Top = oShape.Top
DoEvents
Application.ActiveWindow.View.GotoSlide oSlide.SlideIndex
Debug.Print newShape.Name
End Sub
I have a simple question regarding PowerPoint VBA:
Which VBA code should I use to switch between the "active sheet of paper" (I am sorry I don't know how to name it properly), in which I am doing something with the object(s), and the file (or "field", again sorry for my poor terminology) where all the slides are ?
For example, if I want to move a selected object in the "active sheet of paper" I would use this macro:
ActiveWindow.Selection.ShapeRange.IncrementLeft
6#
and if I want to copy the selected slide in the slides file, I would use this code:
ActiveWindow.Selection.Copy
ActiveWindow.View.Paste
But how can I connect these two pieces of script? Let's say I want to move an object in the "active sheet of paper", then copy this whole "sheet", then create its twin in the slides field, and then jump into the twin sheet of paper to do something with objects there?
Shortly, how do I switch from "paper" to "slides" and back to "paper" in VBA?
(Again, I am sorry for terrible terminology here, I hope you understand what I mean here.)
Thank you all in advance.
If you record a macro in PowerPoint and examine the code, you'll see that it uses the Selection object for just about everything. That's sometimes useful (because it means it's more likely that the code will do what you want if you select another object), but for anything more than a very short macro, it's probably better to refer to the objects directly, as in the following code:
Sub Test()
' Get the active presentation
Dim oPresentation As Presentation
Set oPresentation = ActivePresentation
' Get the first slide in the presentation
Dim oSlide As Slide
Set oSlide = oPresentation.Slides(1)
' Get the first shape on the slide
Dim oShape As Shape
Set oShape = oSlide.Shapes(1)
' Nudge the shape to the right
oShape.Left = oShape.Left + 1
' Copy the whole slide
oSlide.Copy
' Paste the slide as a new slide at position 2
Dim oNewSlides As SlideRange
Set oNewSlides = oPresentation.Slides.Paste(2)
' Get a reference to the slide we pasted
Dim oNewSlide As Slide
Set oNewSlide = oNewSlides(1)
' Get the first shape on the NEW slide
Dim oNewShape As Shape
Set oNewShape = oNewSlide.Shapes(1)
' Nudge the shape to the right
oNewShape.Left = oNewShape.Left + 1
End Sub
Note that pretty much every object has a Select method, so if you do want to explicitly select something, you can. In some cases, you may need to change the active window's view type first - so for example, you can't select a shape on a slide while in slide-sorter view.