Select shapes based on fill color...then do something

[visioVBArookie]

Can any help please? I've been poring over forums for the past two days and cannot figure out how to write this program.

Scenario: Two objects have been grouped, one has a distinct RGB fill color, say 255,0,0, the other does not have any color. Lets call the two shapes shpA and shpB respectively.

Objective: User manually select the group and executes a vba macro. Based upon the user selection, the macro should subselect shpA and use it as the base shape for top alignment. Secondly I am trying to have it put a 0.5 in horizontal distance between shpA and shpB with shpA being on the left. I may be able to write the second part on my own or use a recorder to figure it out.

Obstacle: There is no set pattern to the two grouped shapes, only difference is once has color.

Additional Info: Not sure if this matters, but when I was trying to programmatically identify the shapes using the following code, the shapes were identified as "Sheet.247" and "Sheet.250"

Code Select Expand


Public Sub Item_Example()
 
    Dim intCounter As Integer
    Dim intShapeCount As Integer
    Dim vsoShapes As Visio.Shapes

    Set vsoShapes = ActiveDocument.Pages.Item(1).Shapes

    Debug.Print "Shape Name List For..."
    Debug.Print "Document: "; ActiveDocument.Name
    Debug.Print "Page: "; ActiveDocument.Pages.Item(1).Name

    intShapeCount = vsoShapes.Count

    If intShapeCount > 0 Then
        For intCounter = 1 To intShapeCount
            Debug.Print " "; vsoShapes.Item(intCounter).Name
        Next intCounter
    Else
        Debug.Print " No Shapes On Page"
    End If

End Sub


[Surrogate]

Two objects have been grouped, one has a distinct RGB fill color, say 255,0,0, the other does not have any color. Lets call the two shapes shpA and shpB respectively.

Obstacle: There is no set pattern to the two grouped shapes, only difference is once has color.

What is your main question: how identify which shape in group have fill (solid fill pattern) ?

[visioVBArookie]

Yes. I am trying to use shpA (the shape with a solid fill) and use it as the primary shape to do an alignment.

[Surrogate]

Please try this code

Code Select Expand

Dim sh As Shape, shA As Shape, shB As Shape, ssh As Shape
Set sh = ActivePage.Shapes(1)
' check is first sub-shape have RGB sub-string in formula in FillForegnd cell *
If InStr(sh.Shapes(1).Cells("FillForegnd").Formula, "RGB") Then
Set shA = sh.Shapes(1)
Set shB = sh.Shapes(2)
Else
Set shA = sh.Shapes(2)
Set shB = sh.Shapes(1)
End If
* - IMHO Themes in Visio is evil ! I use Visio Online Plan2, I create new document, set No Themes option and when I look in shapesheet of each shape I find there

[Nikolay]

Hmmm... Why are you using some shape for the alignment?
Isn't easier just to open the group, and align the shapes normally (Group => Open)?
That should open the group contents in a separate window, where you can align the shapes inside of the group, with standard "Align" commands.

[visioVBArookie]

Thanks for the replies Surrogate and Nikolay.

Surrogate, it is not working based off of RGB. It is detecting the wrong one. I've linked a sample drawing i am trying to work with.

Nikolay, if there were only a few shapes then yes. I'll have hundreds to do which is why I want a macro.

Here is a link to the sample drawing file. BTW, no themes are used in this drawing.
https://www.dropbox.com/s/luxp2tf4bhujldz/sample.vsdx?dl=0

[Surrogate]

it is not working based off of RGB. It is detecting the wrong one. I've linked a sample drawing i am trying to work with.

Of course my code can't works in this case, because in your sample document you another group structure !
Group do not contain two simple shapes. It contain two group shapes !

[Surrogate]

try new updated code

Code Select Expand

Sub visioVBArookie()
Dim sh As Shape, shA As Shape, shB As Shape
Set sh = ActivePage.Shapes(1)
' check is first sub-shape of first sub-shape have RGB sub-string in formula in FillForegnd cell
If InStr(sh.Shapes(1).Shapes(1).Cells("FillForegnd").Formula, "RGB") Then
Set shA = sh.Shapes(1)
Set shB = sh.Shapes(2)
Else
Set shA = sh.Shapes(2)
Set shB = sh.Shapes(1)
End If
pxa = shA.Cells("PinX")
shB.Cells("PinX").Formula = "Sheet." & shA.ID & "!Width*0.5+sheet." & shA.ID & "!PinX+33 mm"
ActiveWindow.DeselectAll
sh.UpdateAlignmentBox
MsgBox "TheEnd!"
End Sub

If first sub-shape have fill, we select second sub-shape an move it to right side

[Croc]

If InStr(sh.Shapes(1).Shapes(1).Cells("FillForegnd").Formula, "RGB") Then

1. Cells ("FillForegnd") can contain both the RGB formula and the color index. In the second case, this condition will not work.
2. The term "the other does not have any color" is likely need treat as "FillPattern = 0"
-------
As I understood after some research, the value of color can be obtained as follows:
ActiveDocument.Colors(shp.Cells("FillForegnd").Result(251))
or
Hex(ActiveDocument.Colors(shp.Cells("FillForegnd").Result(251)))

[Nikolay]

Here is the related link on this forum:
http://visguy.com/vgforum/index.php?topic=1061.0

Code Select Expand

shp.Cells("FillForegnd").ResultStrU(visNoCast)

The above results in a raw string like "RGB(217, 150, 144)", independent on your Visio locale, themes applied or of the pre-defined colors used.

[Croc]

But if the color is specified using an index, then such expression will return not the value of the RGB, but the index. For example, 6.

[Nikolay]

You are right. Did not verify properly. Sorry for the misleading comment. It does not work for the index.

[Surrogate]

Sorry for OFFTOP: last time I create new documents rarely. Now I use Visio online plan 2, in this version all cells in Fill format/Line format sections contain formulas like Themeval/Themeguard/etc even I set 'No theme' option!
How prevent  this ugly theme-related formulas ?
I know just one way - save document in vsd format. Anyone know alternatives?

[visioVBArookie]

Thank you Surrogate! Your second suggestion worked just as I had hoped. I have a few more things to touch up to make everything work as I had initially described. Once completed I will post the code in full.

[visioVBArookie]

I have a followup question. Not all shA are the same width and sometimes shB overlaps shA with this formula:

Code Select Expand


shB.Cells("PinX").Formula = "Sheet." & shA.ID & "!Width*0.5+sheet." & shA.ID & "!PinX+33 mm"


In my mind if the left edge of shA and shB were the same, shB should be moved the width of shA + fixed amount. What would need to be modified to achieve this?