Author Topic: Addition of user property to an existing shape  (Read 346 times)

0 Members and 1 Guest are viewing this topic.

william slaney

  • Newbie
  • *
  • Posts: 8
Addition of user property to an existing shape
« on: June 15, 2022, 02:44:04 AM »
I have shamelessly borrowed this code (thank you Visio Guy) and wrapped it in a callable sub.  When I first ran this it produced a system error #NAME although the code compiles without error.   The second time I tried it (trying to pin point the error) it came back another error "Delivery name already exits, choose another"  Examining the shape sheet reports a partially completed property but it does not meet .CellExistsU().

Here's the code:

Private Sub AddShapeProp(ByRef oShape As Visio.Shape, PropName As String, PropPrompt As String, PropValue As String)
    'Adds the user property to existing shape

    Dim intPropRow As Integer
   
    intPropRow = oShape.AddRow(visSectionProp, visRowLast, visTagDefault)
   
    With oShape
        .Section(visSectionProp).Row(intPropRow).NameU = PropName
        .CellsSRC(visSectionProp, intPropRow, visCustPropsLabel).FormulaU = QuoteIt(PropName)
        .CellsSRC(visSectionProp, intPropRow, visCustPropsType).FormulaU = "0"
        .CellsSRC(visSectionProp, intPropRow, visCustPropsFormat).FormulaU = ""
        .CellsSRC(visSectionProp, intPropRow, visCustPropsLangID).FormulaU = "1043"
        .CellsSRC(visSectionProp, intPropRow, visCustPropsCalendar).FormulaU = ""
        .CellsSRC(visSectionProp, intPropRow, visCustPropsPrompt).FormulaU = PropPrompt
        .CellsSRC(visSectionProp, intPropRow, visCustPropsValue).FormulaU = PropValue
        .CellsSRC(visSectionProp, intPropRow, visCustPropsSortKey).FormulaU = ""
    End With
   
End Sub

Don't seem to be able to paste a snip from the shape sheet But I can email it if needed, also the function Quoteit() just appends fore and aft quotes  to the value


Surrogate

  • Hero Member
  • *****
  • Posts: 1564
    • ShapeSheet™ Knowledge Base
Re: Addition of user property to an existing shape
« Reply #1 on: June 15, 2022, 03:09:27 AM »
but it does not meet .CellExistsU().
Which flag do you use as fExistsLocally in CellExistsU ?

Yacine

  • Hero Member
  • *****
  • Posts: 2950
Re: Addition of user property to an existing shape
« Reply #2 on: June 15, 2022, 05:08:24 AM »
To add to surrogate.
You can move the cellexistsU into the subroutine, make the sub a function and handle the error if the name exists.
Return an object if everything is fine (eg the row) or nothing if an error occured.
Yacine

william slaney

  • Newbie
  • *
  • Posts: 8
Re: Addition of user property to an existing shape
« Reply #3 on: June 15, 2022, 10:57:41 PM »
Hi Yacine,  and thank you

I was using this:

       Private Const msUSERPROPNAME As String = "Delivery" 

       If oShape.CellExistsU("Prop." & msUSERPROPNAME, visExistsAnywhere) = 0 Then
              Call AddShapeProp(oShape, msUSERPROPNAME, "Deliverable", "")
       End If
However since it should only exist locally, would I better off using visExistsLocally

Yacine

  • Hero Member
  • *****
  • Posts: 2950
Re: Addition of user property to an existing shape
« Reply #4 on: June 16, 2022, 02:08:05 AM »

However since it should only exist locally, would I better off using visExistsLocally

I wouldn't, visExistsEveryWhere covers all the cases.
Yacine

william slaney

  • Newbie
  • *
  • Posts: 8
Re: Addition of user property to an existing shape
« Reply #5 on: June 16, 2022, 03:56:24 AM »
Have taken you advice  and converted the sub to a function which returns a null string if without problem or the error string generated otherwise'

Private Function AddShapeProp(ByRef oShape As Visio.Shape, PropName As String, PropPrompt As String, PropValue As String) As String
    'Adds the user property to existing shape and reurns a null string if successful or and error message otherwise

    Dim intPropRow As Integer
   
    On Error GoTo ErrTrap
   
    AddShapeProp = ""
    intPropRow = oShape.AddRow(visSectionProp, visRowLast, visTagDefault)
   
    With oShape
        .Section(visSectionProp).Row(intPropRow).NameU = PropName
        .CellsSRC(visSectionProp, intPropRow, visCustPropsLabel).FormulaU = QuoteIt(PropName)
        .CellsSRC(visSectionProp, intPropRow, visCustPropsType).FormulaU = "0"
        .CellsSRC(visSectionProp, intPropRow, visCustPropsFormat).FormulaU = ""
        .CellsSRC(visSectionProp, intPropRow, visCustPropsLangID).FormulaU = "1043"
        .CellsSRC(visSectionProp, intPropRow, visCustPropsCalendar).FormulaU = ""
        .CellsSRC(visSectionProp, intPropRow, visCustPropsPrompt).FormulaU = PropPrompt
        .CellsSRC(visSectionProp, intPropRow, visCustPropsValue).FormulaU = PropValue
        .CellsSRC(visSectionProp, intPropRow, visCustPropsSortKey).FormulaU = ""
    End With
   
ExitHere:
    Exit Function
   
ErrTrap:
    AddShapeProp = Str(Err.Number) & " : " & Err.message
    Resume ExitHere
   
End Function

However it did produce an error which I captured as a .png file but totally unable to attach to this discussion, nor the shape sheet data for the relevant selected shape.


The  error message  was :
System error 438 : Object doesn't  support this object or method

The shape data would  reveal  so much but more unable to attach .png file

Surrogate

  • Hero Member
  • *****
  • Posts: 1564
    • ShapeSheet™ Knowledge Base
Re: Addition of user property to an existing shape
« Reply #6 on: June 16, 2022, 04:07:47 AM »
but totally unable to attach to this discussion
you can save this picture to any popular picture hostings and insert there with syntax like (ie add there embedded picture)
Code
[img]<hyperlink to your picture at picture hosting>[/img]
Which line of code get error ?
« Last Edit: June 16, 2022, 04:12:40 AM by Surrogate »

Yacine

  • Hero Member
  • *****
  • Posts: 2950
Re: Addition of user property to an existing shape
« Reply #7 on: June 16, 2022, 04:32:39 AM »
Some thoughts.
  • When debugging comment out the error handling, so the debugger stops in the faulty line.
  • Use the error handling for "unexpected" errors only, they cost a lot of computation time. Better include tests on the obvious errors - section or row does not exist.
  • There's no need spending time on setting default values - the constants that you set - type, format, langID, etc.
  • The QuoteIt function is a nice idea, but is it that more efficient than adding these "chr(34)"?
Otherwise, you may test my code:
Code
Option Explicit


Public Function addShapeProp2(ByRef oShape As Visio.Shape, PropName As String, PropPrompt As String, PropValue As String) As String


'On Error GoTo ErrTrap '


    If Not oShape.SectionExists(visSectionProp, visExistsAnywhere) Then
        oShape.AddSection visSectionProp
    End If


    If Not oShape.CellExists("prop." & PropName, visExistsAnywhere) Then
        oShape.AddNamedRow visSectionProp, PropName, visTagDefault
    End If
   
    oShape.Cells("prop." & PropName & ".label").Formula = Chr(34) & PropName & Chr(34)
    oShape.Cells("prop." & PropName & ".prompt").Formula = Chr(34) & PropPrompt & Chr(34)
    oShape.Cells("prop." & PropName).Formula = Chr(34) & PropValue & Chr(34)
   
'ExitHere: '
'    Exit Function '
'ErrTrap: '
'    addShapeProp = "Error in addShapeProp2: " & Str(Err.Number) & " : " & Err.message '
'    Resume ExitHere '
   
End Function


Sub test()
    Dim shp As Shape
    Dim t As String
   
    Set shp = ActiveWindow.Selection(1)
   
    t = addShapeProp2(shp, "Dings", "Input Dings", "Tralala " & Now)
    If Len(t) > 0 Then
        MsgBox "An Error occured: " & t
    Else
        Debug.Print "All fine"
    End If
End Sub




PS: I'm setting automatically the prop field if it does not exist. This behavior may not always be wanted.
So you could add a flag "add_if_missing" as boolean to the parameters list of the function and if the field does not exist, exit with an according message.
« Last Edit: June 16, 2022, 04:47:48 AM by Yacine »
Yacine

william slaney

  • Newbie
  • *
  • Posts: 8
Re: Addition of user property to an existing shape
« Reply #8 on: June 17, 2022, 01:12:42 AM »
Yacine you are truly a hero.  http://visguy.com/vgforum/Smileys/default/grin.gif

Did note your warning and check if the cellExists before calling to create because some shapes do not need or want this property

Very cool.

Thanks again
William

william slaney

  • Newbie
  • *
  • Posts: 8
Re: Addition of user property to an existing shape
« Reply #9 on: June 18, 2022, 12:49:13 AM »
One thing I forgot to ask and should have : When I retrieve the value of this property which I assume is

  somestring = oShape.Cells("prop." & PropName).Formula

Do I need to take account of the quotes {chr(34)} added when setting the value and, if so, how?

Thank you

Yacine

  • Hero Member
  • *****
  • Posts: 2950
Re: Addition of user property to an existing shape
« Reply #10 on: June 18, 2022, 03:26:00 AM »
For this special case, it is
somestring = oShape.Cells("prop." & PropName).ResultStr("")

then
oShape.Cells("prop." & PropName).Formula = chr(34) & somethingelse & chr(34)

But for your future work you may also investigate on
- all the nuances of Result (ResultIU, ResultInt, ... etc.). This will go in combination with prop.type = 2 (number)
- in case of a number you won't need the "chr(34)".
- in case you want to write a formula instead of a value you wont' need the double quotes neither - eg prop.x = "Guard(PinX)"
Yacine

william slaney

  • Newbie
  • *
  • Posts: 8
Re: Addition of user property to an existing shape
« Reply #11 on: June 20, 2022, 11:21:09 PM »
The weirdest thing, when the property value is set to ""
   moShape.Cells("Prop." & msUSERPROPNAME).ResultStr(visNoCast) returns "None" and not ""

Setting a listbox value with "None" when it's not part of the list creates an error.
It's easy to trap and deal with or is there another constant other than visNoCast which would prevent Visio going into creative writing mode?


Yacine

  • Hero Member
  • *****
  • Posts: 2950
Re: Addition of user property to an existing shape
« Reply #12 on: June 21, 2022, 01:17:50 AM »
On my computer it returns "".

Try ResultStr("")
Yacine