I'm trying to copy paste shape by using VBA in PowerPoint.
This code can't exit from If...End If statement.
What's wrong with my code?
Sub pasteshape()
Dim oSl As Slide
Dim oSh As Shape
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
If oSh.Fill.Type = msoFillSolid Then
oSh.Duplicate
End If
Next
Next
End Sub
You're changing the collection you're iterating, as you're iterating it; that's always a bad idea!
So you have an infinite loop, because every time you duplicate a shape, you effectively add a solid-fill shape to the oSl.Shapes collection, which is then a solid-fill shape that should be duplicated - right?
You need a way to separate the process of knowing which shapes to copy and that of copying solid-fill shapes.
Make a new collection:
Dim solidShapes As Collection
Set solidShapes = New Collection
Now iterate the slides and their shapes, but instead of copying right away, add them to that collection:
For Each currentShape In currentSlide.Shapes
If currentShape.Fill.Type = msoFillSolid Then
solidShapes.Add currentShape
End If
Next
Notice I'm using readable identifiers without Systems Hungarian (aka useless) prefixes (read that link! Especially if you're a firm believer of Hungarian Notation).
Now you can iterate the solidShapes collection, and .Duplicate every item in it.
Related
I'm currently working on PowerPoint VBA and writing a code to be able to copy the first slide and paste it again in the same presentation. However, I keep getting the error "Clipboard is empty or contains data which may not be posted here" and according to Microsoft page the problem is the use of "ActivePresentation"
I'm looking for another way to refer to the slide that I have open without using ActivePresentation. Any help? Ideas?
The line of code I use ActivePresentation is below:
ActivePresentation.Slides(1).Copy
ActivePresentation.Slides.Paste(ActivePresentation.Slides.Count=1)
Don't copy, duplicate
Dim NewSlide as Slide
Set newSlide = ActivePresentation.Slides(1).Duplicate
NewSlide.MoveTo toPos:=4 'move it to become the fourth slide
Slight variant on Harassed Dad's solution. PPT barks at the Set line because Duplicate returns a SlideRange object rather than a Slide object. .Duplicate(1) returns the first slide in the range as a Slide object. This duplicates slide 2 and moves it to the first position in the presentation.
Sub CopySlide()
Dim oSl As Slide
With ActivePresentation
Set oSl = .Slides(2).Duplicate(1)
oSl.MoveTo (1)
End With
End Sub
So I have a sheet with some pictures. All of these are just a copy paste of the original picture so they all have the same name "Flower".
I want to select all of them and flip them. But it will only select the original, how do I get past this? I tried incorporating a loop as well, without luck.
Sub Test()
ActiveSheet.Shapes.Range(Array("Flower")).Select
Selection.ShapeRange.Flip msoFlipHorizontal
End Sub
I know that I could simply rename them to Flower1, Flower2 etc. but the plan is to use this for a lot of pictures, so it would take to long to change manually. If it could all be done with a loop, that would be fine, but then I would still have the same problem as above.
You can loop thru the collection Shapes looking for the shapes with the given name. Try this.
Sub Test()
Dim Pic As Shape
For Each Pic In ActiveSheet.Shapes
If Pic.Name = "Flower" Then Pic.Flip msoFlipHorizontal
Next Pic
End Sub
In addition, you can code this without selecting it. Faster and more reliable.
There are two objects in VBA that could be useful - the shape collection named Shapes and the Shape itself. Thus, you can loop through the collection like this:
Sub Test()
Dim shShape As Shape
Dim shCollection As Shapes
Set shCollection = ActiveSheet.Shapes
For Each shShape In shCollection
shShape.Flip msoFlipHorizontal
Next shShape
End Sub
I am looking for information to help me better understand ".TextFrame" and ".TextRange" objects in PowerPoing VBA. Can anybody help? I have reviewed the stuff on MSDN and am just continually disappointed with the documentation there.
Shapes are the basic building blocks for PPT slides, masters, layouts, notes pages; everything on them is a shape.
Some shapes (lines for example) can't contain text. Those that can contain text have a TextFrame. If a Shape.TextFrame contains text, then you can use Shape.TextFrame.TextRange to get access to (set/read) the properties of all of the text in the TextFrame. Other methods also return a .TextRange that may be some subset of the text within the .TextFrame.
Simple example:
Sub DoSomethingUseless()
Dim oSh as Shape
Dim oSl as Slide
For Each oSl in ActivePresentation.Slides
For Each oSh in oSl.Shapes
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
Debug.Print oSh.TextFrame.TextRange.Text
End If
End If
Next ' Shape
Next ' Slide
End Sub
I'm trying to programatically change the language of each shape in each customlayout in a PowerPoint template and I can't figure out how to do this. I've done it before, but I can't find the macro anymore so I don't really know how I did it. I've been able to select each custom layout though. But I need to loop through each textbox in each layout and select the language as well. My problem is targetting each shape. How do I do this?
This is what I've got so far:
ActiveWindow.ViewType = ppViewSlideMaster
For Each oLayout In ActivePresentation.SlideMaster.CustomLayouts
oLayout.Select
Next
This basically loops through each layout. But I can't figure out how to select each placeholder? How do I do this?
Edit: Resolution is now:
For Each oLayout In ActivePresentation.SlideMaster.CustomLayouts
oLayout.Select
Dim oShape As Shape
For Each oShape In oLayout.Shapes
oShape.Select
Next
Next
Loop through oLayout.Shapes, or perhaps oLayout.Shapes.Placeholders.
Thanks you two. I needed a solution to updating an embedded Excel object on the master slide.
This lead me to the perfect solution
'loops through all shapes in slidemaster
Dim oShape As Shape
For Each oShape In ActivePresentation.SlideMaster.Shapes
oShape.Select
'checks for excel object (type=7)
If oShape.Type = msoEmbeddedOLEObject Then
oShape.OLEFormat.Activate
ActiveWindow.Selection.Unselect 'deactivates shape
End If
Next
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