Visio Guy

Visio Discussions => Programming & Code => Topic started by: Foxfire180 on July 11, 2019, 12:29:25 PM

Title: VBA Help with Code to write to cell for shapes in a group if exist
Post by: Foxfire180 on July 11, 2019, 12:29:25 PM
Hello, i am trying to write some code in Visio to edit a user created cell if it existing for all subshapes in a group. I am by no means an expert in VBA (I just started working in Visio about a month ago)

I can get the Debug.Print to list out the shape ID's (Below) so i know I am onto something but I am not sure how to write the part that writes/changes the value of a property in the shapesheet (In this case a User Cell) if the cell exists (It will not always exist).

Any help would be much appreciated.

Public Sub group()

Dim vsoShapes As Visio.shapes
Dim vsoShape As Visio.Shape
Dim child As Visio.Shape
Dim sel As Visio.Selection

Set sel = Visio.ActiveWindow.Selection

For Each vsoShape In sel
    For Each child In vsoShape.shapes
        'vsoShape.Cells("User.TestShapeVal").FormulaForceU = "Test Works"
        Debug.Print child.ID
               Next
      ' Exit For
       Next
       
End Sub
Title: Re: VBA Help with Code to write to cell for shapes in a group if exist
Post by: Surrogate on July 11, 2019, 03:07:17 PM
If you want write string in quotes to cell you need wrap your text in triple quotes like """Test works"""
Title: Re: VBA Help with Code to write to cell for shapes in a group if exist
Post by: Foxfire180 on July 11, 2019, 03:24:27 PM
When i put the three quotes i am still getting an error in:

vsoShape.Cells("User.TestShapeVal").FormulaForceU = """Test Works"""

Would the fact that some shapes in the group may not contain the user cell?
Title: Re: VBA Help with Code to write to cell for shapes in a group if exist
Post by: Yacine on July 11, 2019, 03:53:21 PM
wrap your code in an IF clause:
if vsoshape.cellexists("user.testshapeval", visexistsanywhere) then
  ...
endif
NB: you'll often find -1 instead of visexistsanywhere, they are equivalent.
Title: Re: VBA Help with Code to write to cell for shapes in a group if exist
Post by: Foxfire180 on July 11, 2019, 04:05:44 PM
Thank you very much Surrogate and Yacine for the help. It seems to be working as intended.
Title: Re: VBA Help with Code to write to cell for shapes in a group if exist
Post by: wapperdude on July 11, 2019, 07:51:10 PM
Sorry, couldn't resist...a few observation issues

One, is minor, it's for those who dislike concatenating  """"""'s, and prefer chr(34).  Code tends to be more obvious.

The 2nd issue deals with what shape is receiving the "text"?  I read the post as indicating it is assigned to the child shapes not the group shape.  Sel as defined is a collection of groups.  So, each vsoShape in sel is a group. Perhaps I'm mis-reading the intent.  The "if" only checks the child shapes for User cell, but not Group shape.  If cell doesn't exist at group level, that could also  produce error if the group is the intended "text" recipient.

Anyway, attached code shows use of chr(34) and adds text to the child shapes.

Public Sub group()

    Dim vsoShapes As Visio.Shapes
    Dim vsoShape As Visio.Shape
    Dim child As Visio.Shape
    Dim sel As Visio.Selection
   
    Set sel = Visio.ActiveWindow.Selection
   
    For Each vsoShape In sel
        Debug.Print vsoShape.Name
        For Each child In vsoShape.Shapes
            Debug.Print child.Name
            If child.CellExists("User.MyCell", visExistsAnywhere) Then
                child.Cells("User.MyCell").Formula = Chr(34) & "Test Works" & Chr(34)
                Debug.Print child.Cells("User.MyCell").ResultStr(visNone)
            End If
        Next
    Next
       
End Sub


Wapperdude