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
Related
Suppose I have the below, in which for every selected shape another one will be created:
For Each Shp In ActiveWindow.Selection.ShapeRange'.GroupItems
as you can see, at the end of the line objects within groups are commented out. Would it be possible to tell VBA to uncomment it, if for example a ListBox gives the option to apply the macro for grouped items? This would not be out of laziness, rather to save lines and possibly reduce the file size. And just to understand more how everything works. Or VBA is intrinsically blind to comments?
Here's a simple example of handling shapes whether within groups or not:
Sub Main()
Dim oSh As Shape
For Each oSh In ActivePresentation.Slides(1).Shapes
Call HandleShape(oSh)
Next
End Sub
Sub HandleShape(oSh As Shape)
Dim x As Long
If oSh.Type = msoGroup Then
For x = 1 To oSh.GroupItems.Count
Call HandleShape(oSh.GroupItems(x))
Next
Else
oSh.Fill.ForeColor.RGB = RGB(255, 0, 0)
End If
End Sub
So I have a Slide on PowerPoint where I have a Macro that should delete all shapes with the name that starts with "element". It does delete the shapes that I want, but not all. I have to run the macro again and then it deletes another bunch of them. So it seems not to be deleting all at once.
Can someone help me? Here's the Macro:
Sub course_reset()
Dim shp As Shape
For Each shp In Slide36.Shapes
If Left(shp.Name, 7) = "element" Then shp.Delete
Next
End Sub
The root cause of this is because of how iteration works. To illustrate:
Say you're at position 42. The object at this position meets the criteria for deletion.
You delete the object.
Object 43 is now object 42, 44 is 43, etc., all the way down the line, to close the gap.
You now move to position 43, and have skipped checking the old object 43.
The simplest way to fix this is to use a For loop starting at the end of the collection.
For i = Slide36.Shapes.Count To 1 Step -1
Then when you delete, you bypass the gap closure entirely.
SOLUTION
I just figured out by experimenting that if I create a variable as a ShapeRange, set it to Slide36.Slides.Range and then do the for each for the ShapeRange, it works! Thank you anyways for the quick reply.
So the code would be like this:
Sub course_reset()
Dim shp As Shape
Dim shprng As ShapeRange
Set shprng = Slide36.Shapes.Range
For Each shp In shprng
If Left(shp.Name, 7) = "element" Then shp.Delete
Next
End Sub
I just want to connect 2 squares after selecting them.
My code below doesn't work, can't see how to fix it:
Sub ConnectSelectedShapes()
Dim shpFirst As Shape
Dim shpSecond As Shape
Dim shpShapes As Shapes
Set shapesRange = ActiveWindow.Selection.ShapeRange
Set shpFirst = shapesRange(1)
Set shpSecond = shapesRange(2)
With shpShapes.AddConnector(Type:=msoConnectorCurve, BeginX:=0, _
BeginY:=0, EndX:=100, EndY:=100).ConnectorFormat
.BeginConnect ConnectedShape:=shpFirst, ConnectionSite:=1
.EndConnect ConnectedShape:=shpSecond, ConnectionSite:=1
.Parent.RerouteConnections
End With
End Sub
You've delcared shpShapes, however you haven't defined it...
Set shpShapes = ActiveWindow.View.Slide.Shapes
And, of course, you'll need to make sure that 2 shapes have been selected before running the code.
Hope this helps!
I have a workbook with many sheets and images that have random names and arbitrary order, the only image that I need is always in the range A2:C14, I'm using the following code to copy the image:
firstSheet.Range("A2:C14").Copy
secondSheet.Range("I6").PasteSpecial
But it only copies the cell text, not the image.
Is there a way to copy an image using Range("A2:C14)" or another way to select the cell to copy the image?
Since CopyPicture is a method of a Shape object, unless you already have a pointer to it, using the Shapes collection is unavoidable
Something like this
Sub Demo()
Dim shp As Shape
Dim rng As Range
Set rng = firstSheet.Range("A2:C14")
For Each shp In firstSheet.Shapes
If Not Intersect(rng, shp.TopLeftCell) Is Nothing Then
' Found it
shp.CopyPicture
secondSheet.Range("I6").PasteSpecial
Exit Sub
End If
Next
End Sub
Suppose I have a TextRange object, and I need to find the Shape that contains that TextRange.
Normally, I can use the Parent property of the TextRange to get the TextFrame that contains it, and then use the Parent property again to get the Shape.
However, if the text is within a table cell, the Parent property of the TextRange is Nothing. (I think this is a "feature" of PowerPoint 2010). EDIT: this is not true except when accessing the TextRange via Selection.TextRange.
Is there any other way I can identify the shape (which in this case would be the table cell)?
UPDATE: thanks to KazJaw, I have looked at this again, and it turns out I can navigate up the Parent chain unless the TextRange I'm starting from was obtained from Selection.TextRange. For my purposes, this is less of a problem.
Based on further discussion in comments below question it seems that the real problem refers to selection object. If one select any text within the table then some test made in Immediate have the following results:
? Typename(ActiveWindow.Selection.TextRange)
TextRange
? Typename(ActiveWindow.Selection.TextRange.Parent)
Nothing
? Typename(ActiveWindow.Selection.TextRange.Parent.Parent)
'>>Error
Additional information also for other programmers. The following I've found a bit confusing making some test to answer the question. (For simple presentation with one slide, one table in it and some cells filled with text)
Sub Test_To_SO()
Dim SL As Slide
Set SL = ActivePresentation.Slides(1)
Debug.Print TypeName(SL.Shapes(1).Table.Cell(1, 1).Shape.TextFrame.TextRange.Parent)
'result >> TextFrame
Debug.Print TypeName(SL.Shapes(1).Table.Cell(1, 1).Shape.TextFrame.TextRange.Parent.Parent)
'result >> Shape
Debug.Print TypeName(SL.Shapes(1).Table.Cell(1, 1).Shape.TextFrame.TextRange.Parent.Parent.Parent)
'result >> Slide !!
End Sub
It's not so much that you can't get there via the selection, it's sometimes a matter of what you've selected. The object model's broken for text in table cells. As noted, ActiveWindow.Selection.TextRange.Parent returns nothing for selected table cell text.
Other text:
Sub GetParentShape()
Dim oSh As Shape
With ActiveWindow.Selection
'Type might be None, Slides or one of the following:
If .Type = ppSelectionShapes Then
Set oSh = ActiveWindow.Selection.ShapeRange(1)
End If
If .Type = ppSelectionText Then
Set oSh = ActiveWindow.Selection.TextRange.Parent.Parent
End If
Debug.Print oSh.Name
End With
End Sub