Cisco stencils: add text Handler

[Marco Sommella]

Hi this is my first post. I need to add text control Handler (for freely move text of shapes) to some icons from this stencil: http://www.cisco.com/web/about/ac50/ac47/PPT_vss.zip .

i have this macro that worked with other stencils:

Sub TextControls()

Dim MyShape As Shape
Dim label As String

If ActiveWindow.Selection.Count < 1 Then
MsgBox "Please, select shapes.", vbOKOnly, "No shapes seletected"
Else
For i = 1 To ActiveWindow.Selection.Count

Set MyShape = ActiveWindow.Selection.Item(i)
label = MyShape.Text
MyShape.Text = ""

'Set User
If MyShape.CellExistsU("User.HasText", 0) = 0 Then
MyShape.AddNamedRow visSectionUser, "HasText", 0
End If
MyShape.CellsU("User.HasText.Value").FormulaU = "NOT(OR(HideText,STRSAME(SHAPETEXT(TheText),"""")))"
MyShape.CellsU("User.HasText.Prompt").FormulaU = """"""

'Set Controls
If MyShape.SectionExists(visSectionControls, 0) Then
MyShape.DeleteSection (visSectionControls)
End If
If MyShape.CellExistsU("Controls.TextPosition", 0) = 0 Then
MyShape.AddNamedRow visSectionControls, "TextPosition", 0
End If
MyShape.CellsSRC(visSectionControls, 0, visCtlX).FormulaU = "Width*0.5"
MyShape.CellsSRC(visSectionControls, 0, visCtlY).FormulaU = "-TxtHeight*0.5"
MyShape.CellsSRC(visSectionControls, 0, visCtlXDyn).FormulaU = "Controls.TextPosition"
MyShape.CellsSRC(visSectionControls, 0, visCtlYDyn).FormulaU = "Controls.TextPosition.Y"
MyShape.CellsSRC(visSectionControls, 0, visCtlXCon).FormulaU = "(Controls.TextPosition > Width / 2) * 2 + 2"
MyShape.CellsSRC(visSectionControls, 0, visCtlYCon).FormulaU = "(Controls.TextPosition.y > Height / 2) * 2 + 2 + 5 * Not (User.HasText)"
MyShape.CellsSRC(visSectionControls, 0, visCtlGlue).FormulaU = "TRUE"
MyShape.CellsSRC(visSectionControls, 0, visCtlTip).FormulaU = """Move text"""

'Set Group Properties
MyShape.CellsSRC(visSectionObject, visRowGroup, visGroupSelectMode).FormulaU = 0
MyShape.CellsSRC(visSectionObject, visRowGroup, visGroupDisplayMode).FormulaU = 2
MyShape.CellsSRC(visSectionObject, visRowGroup, visGroupIsTextEditTarget).FormulaU = "TRUE"
MyShape.CellsSRC(visSectionObject, visRowGroup, visGroupIsSnapTarget).FormulaU = "TRUE"
MyShape.CellsSRC(visSectionObject, visRowGroup, visGroupIsDropTarget).FormulaU = "FALSE"
MyShape.CellsSRC(visSectionObject, visRowGroup, visGroupDontMoveChildren).FormulaU = "FALSE"

'Set Text Transform
MyShape.CellsSRC(visSectionObject, visRowTextXForm, visXFormWidth).FormulaU = "TEXTWIDTH(TheText)"
MyShape.CellsSRC(visSectionObject, visRowTextXForm, visXFormHeight).FormulaU = "TEXTHEIGHT(TheText, TxtWidth)"
MyShape.CellsSRC(visSectionObject, visRowTextXForm, visXMyShapengle).FormulaU = "IF(BITXOR(FlipX,FlipY),1,-1)*Angle"
MyShape.CellsSRC(visSectionObject, visRowTextXForm, visXFormPinX).FormulaU = "Controls.TextPosition"
MyShape.CellsSRC(visSectionObject, visRowTextXForm, visXFormPinY).FormulaU = "Controls.TextPosition.y"

'Set Events
MyShape.CellsSRC(visSectionObject, visRowEvent, visEvtCellDblClick).FormulaU = "OPENTEXTWIN()"

MyShape.Text = label
Next
End If
End Sub

IMHO the problem with the shapes above is that:
In shapesheet it's impossible to add Group properties section, but i can't resolve that.


Some have some idea ?
Tnx for any help


Submitted via EggHeadCafe - Software Developer Portal of Choice
The Guru's Guide To Transact-SQL
http://www.eggheadcafe.com/tutorial...c3-29efb48e739c/the-gurus-guide-to-trans.aspx