I have been wrecking my brain for a day now and can't get to open the Custom Properties of a member shape
programatically, it keeps telling no custom properties exist ...
Dim vsoShape As Visio.Shape
Dim vsoSubShape As Visio.Shape
Set vsoShape = Application.ActiveWindow.Selection.Item(1)
Application.ActiveWindow.DeselectAll
Set vsoSubShape = vsoShape.Shapes.Item("AppContainer")
MsgBox vsoSubShape.Name & " " & vsoSubShape.Cells("Prop.ContainerType").ResultStr(0)
Application.ActiveWindow.Select vsoSubShape, visSelect
vsoSubShape.Application.DoCmd (1312)
the messagebox clearly displays the subshape name and the value of the custom property... ??? ??? ???
manually it works to 'select' the subshape and do Shape, Custom Properties...
what am I missing???
forgot select add. Look at VBE help...select property....it will show how to do this.
This is what I do for an animation project I am working on. Admittedly, this probably looks like a kludge
Sub my_animator_selector()
Dim allshps As Visio.Shapes
Dim my_simcell As Visio.Cell
Dim shp_cnt As Integer
Set allshps = ActivePage.Shapes
shp_cnt = allshps.Count
Set my_animator_selection = ActiveWindow.Selection
my_animator_selection.DeselectAll
For shp_index = 1 To shp_cnt
my_str = allshps.Item(shp_index).CellsSRC(visSectionObject, visRowMisc, visComment).FormulaU
'MsgBox my_str
If my_str = """Animator""" Then
Select Case my_singlestep
Case 0
Case 1
Case 2
Set my_simcell = allshps.Item(shp_index).Cells("user.sim_ptr")
my_simcell.FormulaU = 0
Case 3
Case 4
Set my_simcell = allshps.Item(shp_index).Cells("user.sim_ptr")
If my_simcell.FormulaU > 1 Then my_simcell.FormulaU = my_simcell.FormulaU - 1
Case Else
End Select
my_animator_selection.Select allshps.Item(shp_index), visSelect
End If
Next shp_index
End Sub
vojo,
thanks for the response, but I am looking at your code
and completely miss what this has to do with my problem ??? ???
This did it!
Dim vsoShape As Visio.Shape
Dim vsoSubShape As Visio.Shape
Set vsoShape = Application.ActiveWindow.Selection.Item(1)
Application.ActiveWindow.DeselectAll
Set vsoSubShape = vsoShape.Shapes.Item("AppContainer")
MsgBox vsoSubShape.Name & " " & vsoSubShape.Cells("Prop.ContainerType").ResultStr(0)
Application.ActiveWindow.Select vsoSubShape, visSubSelect
Application.DoCmd (1312)
Use visSubSelect on a member and Use DoCmd on the Application
visselect in mine....vissubselect in following append