Select Sub/Super Shapes via VBA and assign them to a Layer

Started by PhilippS, February 24, 2020, 04:01:00 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

PhilippS

Hi,

I want to Select a specific Shape in a Group which are also grouped with another Group. If im Correct that are Superselected Shapes.
What I want to do is target all of those "CableNr-Shapes" and assign them to a Layer without assigning anything else of the Groups to that Layer so I can Show/Hide those CableNr-Shapes.
Help please.



Nikolay

Are these shapes somehow different from others?
You can select them based on this criteria...
I'd formulate the criteria first, that is.

Like, shapes created from a specific master.. or shapes with text starting with "V".. Something like that.

Or the question is how to iterate over shapes that are in a group? Or how to select shapes, ,that are part of a group, programmatically?

PhilippS

Hi,

I did try a lot with the VBA code but I couldn't get it to work but i also just started using VBA with this problem so im a super newbie.
And yeah @Yacine i looked through some of your post and also went to the Microsoft website you linked but the only thing i could manage was to select all shapes on my page, but I never got it to work to select the subshapes or supersubshapes with VBA always could only grab the whole Grouped shape or got an error that i have to select an object.

I thought about two options either cathing them all through their text which will always be the V001 or A001 something like that or the other way i could think of was to go with the size and form of the shape but i did not manage to get either work.

Its probably 20000 of those cable Nr. I need to assign to a layer which I rather would solve with a script or code somehow.

regards Philipp

Nikolay

Does this sound any reasonable/close to what you are trying to accomplish?

Sub UpdateSubSubShape()

Dim topShape As Shape
For Each topShape In ActivePage.Shapes
    Dim subShape As Shape
    For Each subShape In topShape.Shapes
        Dim subSubShape As Shape
        For Each subSubShape In subShape.Shapes
       
            If subSubShape.Text = "Sheet.3" Then ' put some condition here
                subSubShape.Cells("FillForegnd").FormulaU = "RGB(255,0,0)"
            End If
           
        Next
    Next
Next

End Sub


PhilippS

Hey Nikolay,

thanks that helps so much, with this code right now it targets all Cable Nr. and makes them Red which essentially translates i have to search how i change the action to happening instead of coloring them to assign them to a layer but i guess this will be the easy part. I appreciate the help like a lot. You saved me so much hours of work.

regards Philipp

Nikolay

Yes, this is just some sample code to iterate over the nested shapes... I.e. each shape has a collection of "child shapes". You can iterate over items in that collection.

To put shape on a layer, you could use the following:

ActivePage.Layers("My Layer").Add(subSubShape, 0)

Assuming "My Layer" is the target layer, and you want to remove the shape from all its previous layers (passing 0).
See another example here: https://docs.microsoft.com/en-us/office/vba/api/visio.layer.add

PhilippS

Hey thanks again for the help.

Thats the code which takes care of my problem, and as now it looks like it just works fine.
Your Code examples helped me so much to understand how to solve my problem.

Sub UpdateSubSubShape()

Dim topShape As Shape
Dim subShape As Shape
Dim subSubShape As Shape
Dim vsoLayer As Layer


For Each topShape In ActivePage.Shapes
    For Each subShape In topShape.Shapes
        For Each subSubShape In subShape.Shapes
       
            If subSubShape.Text = "V001" Then
            Set vsoLayer = ActivePage.Layers.Item("VideoCableNr")
            vsoLayer.Add subSubShape, 0
            End If
           
        Next
    Next
Next

End Sub





best regards Philipp