Thanks Doug :-)
I need an idea for a non-programmer how to achieve iterating through groups.
I started with SO which works fine as long as I only take the .Names of the shapes.
But I need to try to check the type of every item in the group too
I have a whole subset of questions to the shape (Sub CheckTextConformity)
This is the code as it runs - but ignores Groups. I started with the idea to call A subroutine for groups - but then what if the Group contains groups too etc.?
From Sub CheckAndReportOhneGroups() I call Sub WhatTypes... and depending on the type I call CheckTextConformity to give me information about the shape (especially text info).
To deal with groups (and possibly groups within groups) use something like this:
Sub Example()
Dim oSh As Shape
Dim oSl As Slide
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
If oSh.Type = msoGroup Then
'Debug.Print "GROUP"
Call DealWithGroups(oSh)
Else
Debug.Print oSh.Name & vbTab & oSh.Type
End If
Next
Next
End Sub
Sub DealWithGroups(oSh As Shape)
Dim x As Long
Debug.Print "GROUP"
For x = 1 To oSh.GroupItems.Count
If oSh.GroupItems(x).Type = msoGroup Then
Call DealWithGroups(oSh.GroupItems(x))
Else
Debug.Print vbTab & oSh.GroupItems(x).Name & vbTab & oSh.GroupItems(x).Type
End If
Next
End Sub
Yes. The snake is eating its own tail. ;-)
Related
I have code that exports slides to PNG files if they meet certain criteria (i.e. have a certain named shape in the slide). There will be occassions where slides will not have any known shape names, but they will be within a named "section".
I know I must somehow use the ActivePresentation.SectionProperties, but I am not sure how to go about doing this. I've tried things along the line of the below code with no success. In this example the name of the section is "Test". There will be many different sections and I would need to do this for several of those sections. Any help would be much appreciated. Thank you!
Dim sld As Slide
i = 1
For Each sld in ActivePresentation.Slides
If ActivePresentation.SectionProperties.Name("Test") Then
ActivePresentation.Slides(i).Export filenamepng & "TEST" & i & ".png", "PNG"
End If
i = i + 1
Next
#Hunter21188
I guess this is what you need.
You will check of which section every slide belongs.
After this you verify if it's from "Test" section, if is true gotcha! Export.
Obs. The function convert SectionIndex, from Slide Atribute to SectionName, that is not in Slides collection.
Sub Test_Export()
Dim sld As Slide
i = 1
DesiredSection = SectionIndexOf("Test")
For Each sld In ActivePresentation.Slides
If sld.sectionIndex = DesiredSection Then
ActivePresentation.Slides(i).Export filenamepng & "TEST" & i & ".png", "PNG"
End If
i = i + 1
Next
End Sub
Function SectionIndexOf(sSectionName As String) As Long
Dim x As Long
With ActivePresentation.SectionProperties
For x = 1 To .Count
If .Name(x) = sSectionName Then
SectionIndexOf = x
End If
Next
End With
End Function
I hope this is a super simple question but for some reason i cant figure it out.
I need to delete a subset of the selected shapes on a powerpoint slide using VBA. I can do this using:
ActivePresentation.Slides(1).Shapes.Range(_Index_).Delete
Where _Index_ is either an array of shape indexes (integers) or shape names (stings).
Since the shape names are not unique (and people i am making this macro for have a nasty habit of having multiple shapes with the same name) i need to rely on the shape index number. My problem is i dont know how to get the index number of a given shape.
I can only see how i get the shape name or shape ID using:
ActiveWindow.Selection.ShapeRange(IdNum).Name
ActiveWindow.Selection.ShapeRange(IdNum).ID
So my question is: How do i get the shape index of selected shapes?
When you group a selection of shapes, the group becomes a new shape appended to the end of the previous z-order position. All of the individual shapes within the group are appended to the z-order after the group shape itself.
I can't find a way of determining which individual item within a group is selected (sub-selected, I guess we should say, since the original parent group remains selected and that's what PPT returns when you query ActiveWindow.Selection.ShapeRange(1).
To identify the currently subselected item within a group, you can use this as a starting point:
Sub WorkWithSubSelectedShapes()
' Do stuff with sub-selected shapes within a group
' Courtesy of Andy Pope
Dim oSh As Shape
Dim oGSh As Shape
Dim x As Long
Set oSh = ActiveWindow.Selection.ShapeRange(1)
' Do something with each shape in the group:
For Each oGSh In oSh.GroupItems
Debug.Print oGSh.TextFrame.TextRange.Text
Next
' Now do something with each SUB-SELECTED
' shape within the group
With ActiveWindow.Selection.ChildShapeRange
For x = 1 To .Count
Debug.Print .Item(x).Name
Debug.Print .Item(x).TextFrame.TextRange.Text
Next
End With
End Sub
Here's some code that may help generally in processing shapes/groups. It takes account of the fact that there might be groups within groups (within groups (within groups)) ...
Sub ProcessShapes()
Dim oSh As Shape
For Each oSh In ActivePresentation.Slides(1).Shapes
If oSh.Type = msoGroup Then
Debug.Print "GROUP" & vbTab & oSh.Name & vbTab & oSh.ZOrderPosition
Call DealWithGroup(oSh)
Else
Debug.Print oSh.Name & vbTab & oSh.ZOrderPosition
End If
Next
End Sub
Sub DealWithGroup(oSh As Shape)
Dim x As Long
For x = 1 To oSh.GroupItems.Count
If oSh.GroupItems(x).Type = msoGroup Then
Call DealWithGroup(oSh.GroupItems(x))
Else
Debug.Print "GROUP ITEM" & vbTab & oSh.GroupItems(x).Name & vbTab & oSh.GroupItems(x).ZOrderPosition
End If
Next
End Sub
And to answer Peter's further (excellent) question, this should work:
Sub TestIndexOf()
MsgBox IndexOf(ActiveWindow.Selection.ShapeRange(1))
End Sub
Function IndexOf(oSh As Shape) As Long
Dim x As Long
With ActiveWindow.Selection.SlideRange.Shapes
For x = 1 To .Count
If .Item(x).Name = oSh.Name Then
' Found it, report it
IndexOf = x
End If
Next
End With
End Function
Try the few lines of code and yow will get names of all the shapes in immediate window (Cttl+G to view Immediate window)
Dim shp As Shape, I As Integer
For Each shp In ActivePresentation.Slides(1).Shapes
I = I + 1
Debug.Print "Index=" & I & " Name= " & shp.Name & " ID= " & shp.Id & " Type= " & shp.Type
Next
I have big shapes on my worksheet (a group of shapes), and inside everyone of them others little shapes (the blue rectangles),
I made a for loop for inside each Big shape to fill automatically the little shapes, but how can I loop over the Big ones, because all the big shapes are similars, and they have the same names for the littles shapes inside ?
How can I acces the little shape from the big one ?
I tried this but didn't worked
ActiveSheet.Shapes.Range(gr).Select
ActiveSheet.Shapes.Range(Array(x)).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Format(Range(y_1).Value, "#,##0") & " k" & Chr(13) & Format(Range(y_2).Value, "#,##0.00") & " DT"
The "gr" variable takes every time the name of the big shapes (Graph_1 .. Graph_5)
and the x variable takes the name of the little shapes inside (rect_1 .. rect_21)
I think this code does not help because my approach it's like how to access a case in an array if I can say ?
For Each myshape In ActiveSheet.Shapes
You can access child shapes inside a group by using following example:
Sub test()
Dim shp As Shape
Dim shpChild As Shape
For Each shp In Sheet1.Shapes
If shp.Type = msoGroup Then
'/ Found a group. List all the child shapes here.
For Each shpChild In shp.GroupItems
Debug.Print "Child name :" & shpChild.Name & " Group name : " & shp.Name
Next
Else
'/ No group. Individual shape.
Debug.Print shp.Name
End If
Next
End Sub
Here... you should have figured it out yourself :)
Sub test()
Dim shp As Shape
Dim shpChild As Shape
For Each shp In Sheet1.Shapes
If shp.Type = msoGroup And shp.Name = "A" Then
'/ Found a group called "A". List all the child shapes here.
For Each shpChild In shp.GroupItems
If shpChild.Name = "X" Then
'/ Found X.
shpChild.TextFrame2.TextRange.Text = "Hello from VBA!!!"
End If
Next
Else
'/ No group. Individual shape.
Debug.Print shp.Name
End If
Next
End Sub
I have a macros that is unfortunately skipping all grouped shapes in PowerPoint where the text requires to be normalized (hard returns swapped with spacemarks). Now, I wrote a 'prepping' script that should find all shapes with text and ungroup those. For some reason it is not working. This should be so simple, yet I cannot get it to work. Please help!
Sub Ungroupallshapes()
Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.Type = msoGroup Then
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then oshp.Ungroup
End If
End If
Next oshp
Next osld
End Sub
Thank you!
I know this is an old post, but I needed a function to ungroup every group in a PowerPoint regardless of issues with animations as mentioned above. I used the following to continue looping through the slide objects while there was a group detected.Sub
Sub Shapes_UnGroup_All()
Dim sld As Slide
Dim shp As Shape
Dim intCount As Integer
intCount = 0
Dim groupsExist As Boolean: groupsExist = True
If MsgBox("Are you sure you want To ungroup every level of grouping On every slide?", (vbYesNo + vbQuestion), "Ungroup Everything?") = vbYes Then
For Each sld In ActivePresentation.Slides ' iterate slides
Debug.Print "slide " & sld.SlideNumber
Do While (groupsExist = True)
groupsExist = False
For Each shp In sld.Shapes
If shp.Type = msoGroup Then
shp.Ungroup
intCount = intCount + 1
groupsExist = True
End If
Next shp
Loop
groupsExist = True
Next sld
End If
MsgBox "All Done " & intCount & " groups are now ungrouped."
End Sub
Groups don't have TextFrames, so you're testing for something that will never happen.
If oshp.Type = msoGroup then oshp.Ungroup
should do it for simple groupings. But ungrouping can have unwanted side effects (blows away any animation on the group shape, for example). And it's not usually necessary. Consider:
Sub ChangeTheText()
Dim oshp As Shape
Dim oSld As Slide
Dim x As Long
For Each oSld In ActivePresentation.Slides
For Each oshp In oSld.Shapes
If oshp.HasTextFrame Then
oshp.TextFrame.TextRange.Text = "Ha! Found you!"
Else
If oshp.Type = msoGroup Then
For x = 1 To oshp.GroupItems.Count
If oshp.GroupItems(x).HasTextFrame Then
oshp.GroupItems(x).TextFrame.TextRange.Text _
= "And you too, you slippery little devil!"
End If
Next
End If
End If
Next
Next
End Sub
That still leaves you with the possible problem of groups within groups (within groups (within groups)) etc. There are ways around that, but if it ain't broke, we don't need to fix it.
Bit of an issue, I have some VBA code that loops through all of the sheets in my ppt, loops through all of the shapes in each ppt, and deletes the ppt if a specific string of text is not found. It seems to work perfectly other than the code seems to stop looping for no reason. I have to hit F5 about 4 times for the code to loop through all the sheets. It could be something to do with my code so I thought I'd try the good people of Stackoverflow first.
Public Sub ExportMBR()
Dim oSld As Slide
Dim oShp As Shape
Dim strSearch As String
Dim i As Integer
strSearch = "R&T MBR"
i = 0
For Each oSld In ActivePresentation.Slides
Debug.Print (ActivePresentation.Slides.Count)
Debug.Print (oSld.Name)
For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
If oShp.TextFrame.TextRange.Find(strSearch) Is Nothing Then
Else
Debug.Print (oSld.Name & " Slide found")
i = i + 1
End If
End If
Next oShp
If i = 0 Then
Debug.Print (oSld.Name & " Deleting")
oSld.Delete
i = 0
End If
i = 0
Next oSld
myQ = "<afilepath>"
myName = myQ & "<anameformat>") & ".pptx"
ActivePresentation.SaveCopyAs myName
Call Shell("explorer.exe " & myQ, vbNormalFocus)
End Sub
There are 34 slides in my ppt, each run will loop through about 7 slides correctly identifying and deleting the slides I do not need, but then without any errors it will just stop looping and continue executing the rest of the code. The string is found on slides 17 and 18 if this makes a difference. I have added few bits extra to try and solve the problem like the debug.prints and the i = 0 but I just can't figure out what I'm doing wrong.
Many thanks in advance!
ppw
Whenever you delete any object within a collection as you loop through each object in that collection, you need to count backwards. So in these cases you cannot use the For Each oSld In ActivePresentation.Slides statement but do this instead:
Dim lCntr as Long
Dim oSld as Slide
For lCntr = ActivePresentation.Slides.Count to 1 Step -1
Set oSld = ActivePresentation.Slides(lCntr)
' Do your stuff here...
Set oSld = Nothing
Next
Download more free PowerPoint macros and add-ins at http://youpresent.co.uk
Because Find(strSearch) & oSld.Delete are at the same loop, you need to separate them !!
Address the slides which you want to del first and then del them.
For example: suppose that you have slide_1 & slide_2 & slide_3 and you want to del slide_1 & slide_2 & slide_3. Actually, your VBA only del slide_1 & slide_3.
In the loop For Each oSld In ActivePresentation.Slides, the finding sequence should be slide_1 => slide_2 => slide_3. However, the first loop cycle will del slide_1, the remaining slides count become 2 (slide_2 & slide_3), so second loop cycle will start from slide_3. That's the reason why.