How to determine the itemfromID to change colors

[Jacques]

I have several shapes that I would like to programmatically change colors. I
have 4 shapes and when I used the Tools - Macro record a new macro I got the
following:


Dim UndoScopeID1 As Long
UndoScopeID1 = Application.BeginUndoScope("Fill Color")

Application.ActiveWindow.Page.Shapes.ItemFromID(16).CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(255,255,0))"

Application.ActiveWindow.Page.Shapes.ItemFromID(16).CellsSRC(visSectionObject,
visRowFill, visFillBkgnd).FormulaU =
"THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEME(""FillColor""),THEME(""FillColor2""))))"

Application.ActiveWindow.Page.Shapes.ItemFromID(16).Shapes.ItemFromID(20).CellsSRC(visSectionObject,
visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(255,255,0))"

Application.ActiveWindow.Page.Shapes.ItemFromID(16).Shapes.ItemFromID(20).CellsSRC(visSectionObject,
visRowFill, visFillBkgnd).FormulaU =
"THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEME(""FillColor""),THEME(""FillColor2""))))"

Application.ActiveWindow.Page.Shapes.ItemFromID(16).Shapes.ItemFromID(19).CellsSRC(visSectionObject,
visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(255,255,0))"

Application.ActiveWindow.Page.Shapes.ItemFromID(16).Shapes.ItemFromID(19).CellsSRC(visSectionObject,
visRowFill, visFillBkgnd).FormulaU =
"THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEME(""FillColor""),THEME(""FillColor2""))))"

Application.ActiveWindow.Page.Shapes.ItemFromID(16).Shapes.ItemFromID(18).CellsSRC(visSectionObject,
visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(255,255,0))"

Application.ActiveWindow.Page.Shapes.ItemFromID(16).Shapes.ItemFromID(18).CellsSRC(visSectionObject,
visRowFill, visFillBkgnd).FormulaU =
"THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEME(""FillColor""),THEME(""FillColor2""))))"
Application.EndUndoScope UndoScopeID1, True

Dim UndoScopeID2 As Long
UndoScopeID2 = Application.BeginUndoScope("Fill Color")

Application.ActiveWindow.Page.Shapes.ItemFromID(11).CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(255,0,0))"

Application.ActiveWindow.Page.Shapes.ItemFromID(11).CellsSRC(visSectionObject,
visRowFill, visFillBkgnd).FormulaU =
"THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEME(""FillColor""),THEME(""FillColor2""))))"

Application.ActiveWindow.Page.Shapes.ItemFromID(11).Shapes.ItemFromID(15).CellsSRC(visSectionObject,
visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(255,0,0))"

Application.ActiveWindow.Page.Shapes.ItemFromID(11).Shapes.ItemFromID(15).CellsSRC(visSectionObject,
visRowFill, visFillBkgnd).FormulaU =
"THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEME(""FillColor""),THEME(""FillColor2""))))"

Application.ActiveWindow.Page.Shapes.ItemFromID(11).Shapes.ItemFromID(14).CellsSRC(visSectionObject,
visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(255,0,0))"

Application.ActiveWindow.Page.Shapes.ItemFromID(11).Shapes.ItemFromID(14).CellsSRC(visSectionObject,
visRowFill, visFillBkgnd).FormulaU =
"THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEME(""FillColor""),THEME(""FillColor2""))))"

Application.ActiveWindow.Page.Shapes.ItemFromID(11).Shapes.ItemFromID(13).CellsSRC(visSectionObject,
visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(255,0,0))"

Application.ActiveWindow.Page.Shapes.ItemFromID(11).Shapes.ItemFromID(13).CellsSRC(visSectionObject,
visRowFill, visFillBkgnd).FormulaU =
"THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEME(""FillColor""),THEME(""FillColor2""))))"
Application.EndUndoScope UndoScopeID2, True

Dim UndoScopeID3 As Long
UndoScopeID3 = Application.BeginUndoScope("Fill Color")

Application.ActiveWindow.Page.Shapes.ItemFromID(6).CellsSRC(visSectionObject,
visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(0,112,192))"

Application.ActiveWindow.Page.Shapes.ItemFromID(6).CellsSRC(visSectionObject,
visRowFill, visFillBkgnd).FormulaU =
"THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEME(""FillColor""),THEME(""FillColor2""))))"

Application.ActiveWindow.Page.Shapes.ItemFromID(6).Shapes.ItemFromID(10).CellsSRC(visSectionObject,
visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(0,112,192))"

Application.ActiveWindow.Page.Shapes.ItemFromID(6).Shapes.ItemFromID(10).CellsSRC(visSectionObject,
visRowFill, visFillBkgnd).FormulaU =
"THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEME(""FillColor""),THEME(""FillColor2""))))"

Application.ActiveWindow.Page.Shapes.ItemFromID(6).Shapes.ItemFromID(9).CellsSRC(visSectionObject,
visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(0,112,192))"

Application.ActiveWindow.Page.Shapes.ItemFromID(6).Shapes.ItemFromID(9).CellsSRC(visSectionObject,
visRowFill, visFillBkgnd).FormulaU =
"THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEME(""FillColor""),THEME(""FillColor2""))))"

Application.ActiveWindow.Page.Shapes.ItemFromID(6).Shapes.ItemFromID(8).CellsSRC(visSectionObject,
visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(0,112,192))"

Application.ActiveWindow.Page.Shapes.ItemFromID(6).Shapes.ItemFromID(8).CellsSRC(visSectionObject,
visRowFill, visFillBkgnd).FormulaU =
"THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEME(""FillColor""),THEME(""FillColor2""))))"
Application.EndUndoScope UndoScopeID3, True

Dim UndoScopeID4 As Long
UndoScopeID4 = Application.BeginUndoScope("Fill Color")

Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject,
visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(0,176,80))"

Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject,
visRowFill, visFillBkgnd).FormulaU =
"THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEME(""FillColor""),THEME(""FillColor2""))))"

Application.ActiveWindow.Page.Shapes.ItemFromID(1).Shapes.ItemFromID(5).CellsSRC(visSectionObject,
visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(0,176,80))"

Application.ActiveWindow.Page.Shapes.ItemFromID(1).Shapes.ItemFromID(5).CellsSRC(visSectionObject,
visRowFill, visFillBkgnd).FormulaU =
"THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEME(""FillColor""),THEME(""FillColor2""))))"

Application.ActiveWindow.Page.Shapes.ItemFromID(1).Shapes.ItemFromID(4).CellsSRC(visSectionObject,
visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(0,176,80))"

Application.ActiveWindow.Page.Shapes.ItemFromID(1).Shapes.ItemFromID(4).CellsSRC(visSectionObject,
visRowFill, visFillBkgnd).FormulaU =
"THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEME(""FillColor""),THEME(""FillColor2""))))"

Application.ActiveWindow.Page.Shapes.ItemFromID(1).Shapes.ItemFromID(3).CellsSRC(visSectionObject,
visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(0,176,80))"

Application.ActiveWindow.Page.Shapes.ItemFromID(1).Shapes.ItemFromID(3).CellsSRC(visSectionObject,
visRowFill, visFillBkgnd).FormulaU =
"THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEME(""FillColor""),THEME(""FillColor2""))))"
Application.EndUndoScope UndoScopeID4, True


I would normaly reference my shapes by using shape(#).... but to change
colors it seems I need to use the itemfromID.

Does anyone know how I can get the itemfromid for a shape or another way of
changing the color of a shape?

 

[JuneTheSecond]

You don't need to use ItemFromId, as next code can change colors of selected
group shape.
for example
Dim shp As Visio.Shape
Set shp = ActiveWindow.Selection(1)
Dim child As Visio.Shape

For Each child In shp.Shapes
child.Cells("FillForegnd").FormulaU =
"THEMEGUARD(THEME(""AccentColor5""))"
Next

ID can be got by Shape.ID property.
If you know ID, ItemFromID is convenient to find directly get the shape
object in the group.

 

[Jacques]

thanks this worked.
I added a reference to shape and I can change the shape I want. Here is the
code
Dim shp As Visio.Shape
Set shp = Application.ActiveWindow.Page.Shapes(4)
For Each child In shp.Shapes
child.Cells("FillForegnd").FormulaU =
"THEMEGUARD(TINT(THEME(""AccentColor3""),24))"
Next

 

[John Marshall, MVP]

Be careful, what you are doing is changing the fourth shape in the shapes
collection on the page. The shape you want may not always be at that
position. Try assigning a name to it or something else to identify. You can
also use the Selection collection to find the shape if it is selected.

John... Visio MVP

Need stencils or ideas? http://visio.mvps.org/3rdparty.htm
Need VBA examples? http://visio.mvps.org/VBA.htm
Visio Wishlist http://visio.mvps.org/wish_list.htm