Visio Guy

Visio Discussions => Programming & Code => Topic started by: william slaney on June 15, 2022, 07:44:04 AM

Title: Addition of user property to an existing shape
Post by: william slaney on June 15, 2022, 07: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

Title: Re: Addition of user property to an existing shape
Post by: Surrogate on June 15, 2022, 08:09:27 AM
Quote from: william slaney on June 15, 2022, 07:44:04 AM
but it does not meet .CellExistsU().
Which flag do you use as fExistsLocally in CellExistsU (https://docs.microsoft.com/en-us/office/vba/api/visio.shape.cellexistsu) ?
Title: Re: Addition of user property to an existing shape
Post by: Yacine on June 15, 2022, 10: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.
Title: Re: Addition of user property to an existing shape
Post by: william slaney on June 16, 2022, 03:57:41 AM
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
Title: Re: Addition of user property to an existing shape
Post by: Yacine on June 16, 2022, 07:08:05 AM
Quote from: william slaney on June 16, 2022, 03:57:41 AM

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

I wouldn't, visExistsEveryWhere covers all the cases.
Title: Re: Addition of user property to an existing shape
Post by: william slaney on June 16, 2022, 08: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
Title: Re: Addition of user property to an existing shape
Post by: Surrogate on June 16, 2022, 09:07:47 AM
Quote from: william slaney on June 16, 2022, 08:56:24 AMbut 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)
[img]<hyperlink to your picture at picture hosting>[/img]
Which line of code get error ?
Title: Re: Addition of user property to an existing shape
Post by: Yacine on June 16, 2022, 09:32:39 AM
Some thoughts.
Otherwise, you may test my 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.
Title: Re: Addition of user property to an existing shape
Post by: william slaney on June 17, 2022, 06: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
Title: Re: Addition of user property to an existing shape
Post by: william slaney on June 18, 2022, 05: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
Title: Re: Addition of user property to an existing shape
Post by: Yacine on June 18, 2022, 08: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)"
Title: Re: Addition of user property to an existing shape
Post by: william slaney on June 21, 2022, 04:21:09 AM
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?

Title: Re: Addition of user property to an existing shape
Post by: Yacine on June 21, 2022, 06:17:50 AM
On my computer it returns "".

Try ResultStr("")