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
Related
I have a Word document with a number of AutoShapes.
I loop through the shapes by a for loop, and select those with a specific foreColor in order to delete them:
For each sh in ActiveDocument.Shapes
if sh.fill.foreColor = myColor then
sh.delete
end if
next i
This does not work. However if I replace sh.fill.foreColor with another color for example, it works perfectly.
The more odd is that if I put sh.delete after sh.fill.foreColor = newColor, the first line doesn't execute !! :
For each sh in ActiveDocument.Shapes
if sh.fill.foreColor = myColor then
sh.fill.forecolor = newColor
sh.delete
end if
next i
According to the documentation, the delete method requires an index argument representing the index of the shape. I tried entering an index, but it doesn't work.
Does anyone know why this happens?
Tank you very much
Try this and see if the output is what you expect:
Sub Tester()
Dim i As Long
For i = activedocument.Shapes.Count To 1 Step -1
With activedocument.Shapes(i)
Debug.Print "#: " & i, "Name: " & .Name, "Color: " & .Fill.ForeColor
If .Fill.ForeColor = 12874308 Then .Delete '<< works fine for me...
End With
Next i
End Sub
Edit: it's pretty straightforward to demonstrate the problem with using the For Each approach. For example this code only deletes half of the shapes in a document on each run:
Dim shp
For Each shp In ActiveDocument.Shapes
shp.Delete
Next shp
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
My Word document has many ActiveX labels. [Not textboxes: my original title was in error.]
I'd like a macro to loop through them to perform an action on each of them (changing the captions), but I don't know how to identify them.
If they were on a userform, I'd say:
For each aLabel in UserForm1.Controls
But that doesn't apply in my case.
Assuming it is textboxes you're working with, per the title but not the question, the document's Shapes collection may be what you're after:
Sub ShapeLoop()
Dim shp As Shape
For Each shp In ThisDocument.Shapes
' Test if shp is one you're interesed in, perhaps using shp.Name
Debug.Print shp.Name
' Do Stuff
Next shp
End Sub
Edit:
Same again for the fields collection
Sub FieldLoop()
Dim fld As Field
For Each fld In ThisDocument.Fields
If TypeName(fld.OLEFormat.Object) = "Label" Then
Debug.Print fld.OLEFormat.Object.Caption
fld.OLEFormat.Object.Caption = "New Caption"
End If
Next
End Sub
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. ;-)