editing shapesheet cells of subshapes of a group - but not all of them

[hidden layer]

Hello,
the plan is to make a group (call it Sheet22) with around 40 shapes in it. Some of them are single shapes, some are groups.

Sometimes the Group Sheet22 shall be rotated but the position of all subshapes shall be the same - but not only this - their orientation shall be gravity-orientated.

I can manually add in all subshapes (that have to stay in gravity) in cell Angle "=-sheet22!Angle" but that's a lot of work.
This formula shall be only in the 1st "available" subshape. If this is a group the shapes within this group shall be skipped.

So I wanted to do this with vba but I didn't found a starting point how to discriminate between shapes that shall contain this formula and the ones that shall be skipped.

Of course I tried to search here and there but not really with matching points.

If someone could give a direction this would be fine.

Thanks!
hl

[Yacine]

The challenge looks tempting, but the problem definition is not clear. What are you trying to achieve?

I understood so far "do stuff, but not for the first sub-shape". I suspect to be more to that.

[wapperdude]

My guess is that by 1st, he means the immediate "children" of the top most parent, which in the example, would be sheet.22.  So only subshapes that reference sheet.22 as parent, get the added anti-gravity cell.  These children may be single shapes or grouped shapes.  The subshapes that belong to each of the 1st level children do not need nor receive the anti gravity cell.

Anyway, that's may interpretation.   Not at my computer most of the day, today.

[hidden layer]

wapperdude is right,

only the shapes that are children of this master-group shall be changed, no matter if they are just shapes or groups.
If they are groups only the shape that represents the group shall be changed - not their so called "grand"- children.

If I change every single shape (down to the last sub-sub-sub-shape) the subshapes of the groups inside the master-group will get erratic behaviour.

The thing is that some of the shapes have text content. Some with fields, some inside groups. This text shall be readable in any rotation angle. Shapes or groups that doesn't contain text (e.g. chairs) shall be with legs to the bottom. That's it.

Don't hurry - it can wait anyway.

Thanks and cheers!

[Croc]

only the shapes that are children of this master-group shall be changed, no matter if they are just shapes or groups.

The shape sheet.21 in the example does not meet this condition. It is a member of the group, but turns with the group.

[Croc]

Maybe this VBA code is good for you

Code

Sub ttt()
    If ActiveWindow.Selection.Count = 1 Then
        Set sg = ActiveWindow.Selection(1)
        For Each sh In sg.Shapes
            If sh.Cells("Width") < sg.Cells("Width") * 0.95 Then
                sh.Cells("Angle").Formula = "-" & sg.NameID & "!Angle"
            End If
        Next
    End If
End Sub

[Yacine]

Got it. I thought the frame were a geometry of the main group.
Croc's answer gives already the right direction, but may limit the solution. Think of a "vertical" group.

I would expand this solution by splitting the operation. In a first step I would define a condition in the shapesheets to separate the gravity shapes from the others.
This could be either a new field (prop or user) or an existing one (e.g. LockRotate).

Something like:
"Please select the shapes that shall no get the gravity formula, then press 'OK'" (or the other way around)

for each shp in activewindow.selection
  shp.cells("LockRotate").FormulaU = 1
or
  shp.AddNamedRow visSectionUser, "NoGravity", visTagDefault
  ' you could add a value as well, maybe for modifying the group later on
next shp

and only then you would apply the formulas:
for each shp in groupShp.Shapes
  if shp.Cells("LockRotate").ResultIU = 1 then
    apply formula here
  end if
or
  if shp.CellExists("user.NoGravity",False) then
    ...
  end if
next shp

Note that the first step - definition of the non-gravity shapes could be a manual operation without code.

[hidden layer]

Hi Croc, Yacine
yes, the direction was right. Thanks!

(I don't have a clue what this "Cells("Width") < sg.Cells("Width") * 0.95" shall be made for but anyway)
I'm a step forward. It's not the final solution but it works. Here we go:

Code

Sub ttt()
Dim sh As Visio.Shape
Dim sg
Dim col As String

If ActiveWindow.Selection.Count = 1 Then
    Set sg = ActiveWindow.Selection(1)
    For Each sh In sg.Shapes
        col = sh.Cells("Char.color").Formula
        sh.Cells("Char.color").FormulaU = "RGB(255,0,0)"
        If MsgBox("Change Shape " & sh.ID & "?", vbYesNo, "Shall this shape have gravity?") = vbYes Then
            sh.Cells("Angle").FormulaU = "-" & sg.NameID & "!Angle"
        End If
        sh.Cells("Char.color").Formula = col
    Next
End If
End Sub

So I have to watch it working and choose the correct shapes to be modified.

any tips for furthermore automatisation are welcomed

cu!

hl

[wapperdude]

Couple things in your code...
1)  the "col =" line should have result syntax rather than formula.  "Result" fetches from the referenced cell, whereas "formula" inserts an entry into the cell.

2) Asking about "gravity" is a bit misleading/incorrect.  There is a gravity shapesheet fcn and it behaves differently than the negative angle formula that is actually used.

3)  Your comment about watching the shapes...  No.  You shouldn't have to...unless you havent told us everything.  The code only edits the first layer subshapes in the selected shape.  It looks at all such shapes.  If any of these are themselves subshapes, it does not push down into those child shapes.  That is the behavior you requested, and the code does that.

4)  In Croc's code, you ought to be able to remove the IF & End If statements that check the width.  Just leave the code line between them.

[hidden layer]

Hi wapperdude,
thanks for the comments.
I did not know the gravity-formula until now. So I described just the behaviour.

To point 3: there is one shape in the "master"-group that is the outline of the whole thing. That one shall rotate of course. And because I cannot say that is the 1st shape that the routine may find I did it that way. This I did not consider earlier 
I think about to check it's ID and enter it at the start to not have to watch...

step by step.

cheers!

[wapperdude]

If thee is something(s) that are unique, either singularly or a combination of factors, the code could be modified to check for these and then exclude the shape.

[hidden layer]

I got it: usually the biggest shape (in mm²) is the outline of the master group. Checking this and exclude from treatment.
Thanks to all!

hl