Custom Properties

Started by KP, May 28, 2008, 01:55:13 AM

Previous topic - Next topic

0 Members and 2 Guests are viewing this topic.

KP

Hi Visio guy!

Great site very helpful.

I have quite a few Process maps and rather than doing it manually for every activity on each process map I was wondering if there is any code I can use to automate the setting for "Invisible" to "True" for the following properties:

- Total Effort (man-hours)
- Total Cost
- Elapsed Time (days)
- Frequency of Occurance (weekly)

My thanks in advance!

Regards

KP

Lars-Erik

Just to make sure were all on the same page,

you have a Visio file, in which you have shapes with:
- Total Effort (man-hours)
- Total Cost
- Elapsed Time (days)
- Frequency of Occurance (weekly)
And you want to have a quick and easy way to set these property fields to invisible/visible?

A question:
- Are they set separetly or if "total effort" is hidden, the rest has to be hidden aswell?

1. Have you thought about using an excel file to "link" data to shapes, and using that data to hide property fields?
2. Another way would be to use VBA, make  a macro to hide fields on the currently selected shapes.

Personaly I'd go with option 1, I would rather not use VBA if its not necessary.

Make an excel sheet with in the top the names of the fields you want to hide.
Then all the posible combinations you need, if they all need to be hidden you need two.
Linking the data to your Visio, you can then use the property fields ( where the linked data ends up ) to control the visible fields.

- Lars

KP

Hi Lars

Thanks for your reply, much appreciated.

To clarify:

I have multiple visio files which have drill downs and also been published to an intranet. These files have shapes (namely Activity boxes) that hold the mentioned properties which we do not want the users to see.

Now I chose option 2 as I am not familiar with how to link Visio to Excel.

Q. Could you tell me more about how to go about this?

In my case for each activity box to hide the four properties i.e. set Invisible to TRUE i have the following code but this would be really cumbersome if I were to try and get the Activity ID for each and every shape and add the code for it.

So is there a simple way collectively run the code in ALL process maps and apply to EACH and EVERY activity box?

Code:

Sub Macro2()

    Application.ActiveWindow.Page.Shapes.ItemFromID(152).OpenSheetWindow
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 15, visCustPropsInvis).FormulaU = "true"
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 16, visCustPropsInvis).FormulaU = "true"
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 17, visCustPropsInvis).FormulaU = "true"
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 18, visCustPropsInvis).FormulaU = "true"
    Application.ActiveWindow.Close

End Sub

Note:

1) ItemFromID(152) is the shape I need to apply this change to and is one of my biggest headaches. Any chance I can run the code for ALL shapes on ALL the maps without having the ID or worry about drill downs?

2) These are the fields I want to hide in ALL the shapes where from the code:

15 rep - Total Effort (man-hours)
16 rep - Total Cost
17 rep - Elapsed Time (days)
18 rep - Frequency of Occurance (weekly)

Thanks for your feed back :-)

Appreciate it a lot.

Regards

KP

Lars-Erik

#3
Ok, I understand it a bit better now.

I took some code from Chris (Visguy) post and changed it a bit
I didnt have time to test it yet but here goes.

Public Sub ForAllShapes()

    Dim shp As Visio.Shape
    Dim collShapes As Collection
    Dim i As Integer, j As Integer

'// we are gone get all shapes from the page
    Set collShapes = New Collection

    '// For this example, we will get all shapes on the page
    '// that ARE NOT of these:
    '//
    '//  1. Connectors
    '//  2. Foreign objects (like Buttons)
    '//  3. Guides

    For Each shp In ActivePage.Shapes

        If (shp.OneD = False) And _
           (shp.Type <> Visio.VisShapeTypes.visTypeForeignObject) And _
           (shp.Type <> Visio.VisShapeTypes.visTypeGuide) Then

            Call collShapes.Add(shp)

        End If

    Next
   
    '// now we set the properties
    '// Loop through the shapes in the shapes collection:
    For i = 1 To collShapes.Count
    '// Loop through the properties that need to be hidden:
    For j = 15 To 18

        collShapes.Item(i).CellsSRC(visSectionProp, j, visCustPropsInvis).FormulaU = "true"

         Next j

    Next i

End Sub


Hope it works, but I think you might need to tinker with it some more. Either way should be a nice step in the right direction?

- Lars


EDIT:
Ran a small test, using this code to edit the width of some random shapes on my page, worked. So it might just work straight out of the box :O

KP

 :o

Woah! Lar you the man! You gave me a whole code!!!

I understand most of it but the bad news is that the code is giving me the error "Cannot create Object" and points to:

collShapes.Item(i).CellsSRC(visSectionProp, j, visCustPropsInvis).FormulaU = "true"

Now I am not a VBA expert but I understand you are collecting ALL the objects in the process map and then assigning the condition to change the "Invisible" property to "TRUE" for all the properties I want to hide.

I appreciate your help so far... any chance of getting just a little bit more here? Please?

Thanks in advance!


Lars-Erik

#5
Doh!

To test the code I created a bunch of squares, give them 2 custom properties and made the macro hide it. Worked like a charm.
I think all shapes in the collection NEED (in your case) the:
15 rep - Total Effort (man-hours)
16 rep - Total Cost
17 rep - Elapsed Time (days)
18 rep - Frequency of Occurance (weekly)
If a shapes doesnt have this, the macro will give the error you mentioned.
Can you check if your drawing has shapes on it that doesnt have these properties?
A workaround would be to have the macro use the selected items instead of all items on the page.

To have the code run for the selection and not the page replace:
  For Each shp In ActivePage.Shapes
With
For Each shp In ActiveWindow.Selection

Aslong as you select all shapes with the mentioned properties the code should run.
I guess should add a way of error handling aswell... mmm

- Lars

Heres the whole code for the selection method thingy, with some error handling:

Public Sub ForAllShapes()

On Error GoTo Err

    Dim shp As Visio.Shape
    Dim collShapes As Collection
    Dim i As Integer, j As Integer

'// we are gone get all shapes from the page
    Set collShapes = New Collection

    '// For this example, we will get all shapes on the page
    '// that ARE NOT of these:
    '//
    '//  1. Connectors
    '//  2. Foreign objects (like Buttons)
    '//  3. Guides

 
    For Each shp In ActiveWindow.Selection
        If (shp.OneD = False) And _
           (shp.Type <> Visio.VisShapeTypes.visTypeForeignObject) And _
           (shp.Type <> Visio.VisShapeTypes.visTypeGuide) Then

            Call collShapes.Add(shp)

        End If

    Next
   
    '// now we set the properties
    '// Loop through the shapes in the shapes collection:
    For i = 1 To collShapes.Count
    '// Loop through the properties that need to be hidden:
    For j = 0 To 1

        collShapes.Item(i).CellsSRC(visSectionProp, j, visCustPropsInvis).FormulaU = "true"

         Next j

    Next i
Exit Sub
Err:
MsgBox ("An error occoured, are you sure all selected shapes meet the requirements for the preformed action?")
End Sub

KP

Lar baby!

You da man! Sorry i been at this the whole day and i guess my brains just fizzled out right now... i have added the code for Sort Key as well to neaten up the activities on my process map... will test it out 2mw and post the entire code to you... Thanks a million for your help!

If i find a way to run the code without having to manually select each shape that wud be GREAT but for now Good day and Good nite!

I owe you drinks ma man!!!

Cheers!

KP

Lars-Erik

#7
You're welcome, let us know how it works out.

- Lars

I can't stand it when the code is half done like above :) I made some more changes.
- Back to all shapes on the page, so no more selecting
- It checks if a shape exists BEFORE it tries to change it, so no more errors
- Still has error handling just in case
- Undo scope added so you can undo the changes afterwards

Public Sub ForAllShapes()
Dim UndoScopeID1 As Long
    UndoScopeID1 = Application.BeginUndoScope("Hide fields")
'On Error GoTo Err

    Dim shp As Visio.Shape
    Dim collShapes As Collection
    Dim i As Integer, j As Integer

'// we are gone get all shapes from the page
    Set collShapes = New Collection

    '// For this example, we will get all shapes on the page
    '// that ARE NOT of these:
    '//
    '//  1. Connectors
    '//  2. Foreign objects (like Buttons)
    '//  3. Guides

 
    For Each shp In ActivePage.Shapes
        If (shp.OneD = False) And _
           (shp.Type <> Visio.VisShapeTypes.visTypeForeignObject) And _
           (shp.Type <> Visio.VisShapeTypes.visTypeGuide) Then

            Call collShapes.Add(shp)

        End If

    Next
   
    '// now we set the properties
    '// Loop through the shapes in the shapes collection:
    For i = 1 To collShapes.Count
    '// Loop through the properties that need to be hidden:
        For j = 15 To 18
    '// We check if the cell exists
            If collShapes.Item(i).CellsSRCExists(visSectionProp, j, visCustPropsInvis, False) = -1 Then
    '// If it does
                collShapes.Item(i).CellsSRC(visSectionProp, j, visCustPropsInvis).FormulaU = "true"
            Else
    '// If it doesn't
            End If
       
        Next j

    Next i
Application.EndUndoScope UndoScopeID1, True
Exit Sub
Err:
MsgBox ("An error occoured, are you sure all selected shapes meet the requirements for the preformed action?")
Application.EndUndoScope UndoScopeID1, False
End Sub


Visio Guy

Quote from: KP on May 28, 2008, 08:22:56 AM

Woah! Lar you the man! You gave me a whole code!!!
...


I really need to implement the Buy Me A Beer mod for this board. That way everybody can shoot each other a few bucks/euros vis PayPal...

:) ;)
For articles, tips and free content, see the Visio Guy Website at http://www.visguy.com
Get my Visio Book! Using Microsoft Visio 2010

KP

Lars I must say I admire your perseverance! I stayed up late to finish up with the other requirements and your last code helped iron out a lot of wrinkles... Thanks a million buddy!

Lars-Erik

#10
KP was also looking for code to order items using the label name instead of the index.
Personaly I don't think the code is the cleanest ever ( running true 30 properties, tsktsk )
Anyway, if people have any input, or can use it here's what we came up with.

The code below looks for six labels, and orders them. you can add more as you need.
You can do whatever you want to the items, hide them, order them, put in value's.


Public Sub ForAllShapes()

Dim UndoScopeID1 As Long
UndoScopeID1 = Application.BeginUndoScope("Order Fields")

Dim shp As Visio.Shape
Dim collShapes As Collection
Dim i As Integer, j As Integer, n As Integer
       
'// Get all shapes from the page
   
Set collShapes = New Collection
   
'// Shapes not considererd:
'//  1. Connectors
'//  2. Foreign objects (like Buttons)
'//  3. Guides
   
For Each shp In ActivePage.Shapes

If (shp.OneD = False) And _
(shp.Type <> Visio.VisShapeTypes.visTypeForeignObject) And _
(shp.Type <> Visio.VisShapeTypes.visTypeGuide) Then

Call collShapes.Add(shp)

End If

Next
   
'// Set the properties
'// Loop through ALL the shapes in the shapes collection:
   
For i = 1 To collShapes.Count
   
' Run through the first 30 properties looking for the right labels
' Check If the cell exists
' Then check if its the right description
' Then change the sortkey
' Exit when changed
' If none of the above do nothing and go to next property

' Changing Prop.Description

n = 0

For n = 0 To 30

If collShapes.Item(i).CellsSRCExists(visSectionProp, n, visCustPropsLabel, False) = -1 Then
If collShapes.Item(i).CellsSRC(visSectionProp, n, visCustPropsValue).RowNameU = "Description" Then
collShapes.Item(i).CellsSRC(visSectionProp, n, visCustPropsSortKey).FormulaU = "1"
Else

End If

Else
'If it does not exist
End If

Next n

'Changing Prop.Responsibility

For n = 0 To 30

If collShapes.Item(i).CellsSRCExists(visSectionProp, n, visCustPropsLabel, False) = -1 Then
If collShapes.Item(i).CellsSRC(visSectionProp, n, visCustPropsValue).RowNameU = "Responsibility" Then
collShapes.Item(i).CellsSRC(visSectionProp, n, visCustPropsSortKey).FormulaU = "2"
Else

End If

Else
'If it does not exist
End If

Next n

'' Prop.ACCOUNTABILITY

For n = 0 To 30

If collShapes.Item(i).CellsSRCExists(visSectionProp, n, visCustPropsLabel, False) = -1 Then
If collShapes.Item(i).CellsSRC(visSectionProp, n, visCustPropsValue).RowNameU = "ACCOUNTABILITY" Then
collShapes.Item(i).CellsSRC(visSectionProp, n, visCustPropsSortKey).FormulaU = "3"
Else

End If

Else
'If it does not exist
End If
Next n

'Change Prop.CONSULTED

For n = 0 To 30

If collShapes.Item(i).CellsSRCExists(visSectionProp, n, visCustPropsLabel, False) = -1 Then
If collShapes.Item(i).CellsSRC(visSectionProp, n, visCustPropsValue).RowNameU = "CONSULTED" Then
collShapes.Item(i).CellsSRC(visSectionProp, n, visCustPropsSortKey).FormulaU = "4"
Else

End If

Else
'If it does not exist
End If

Next n

'Change Prop.INFORMED

For n = 0 To 30

If collShapes.Item(i).CellsSRCExists(visSectionProp, n, visCustPropsLabel, False) = -1 Then
If collShapes.Item(i).CellsSRC(visSectionProp, n, visCustPropsValue).RowNameU = "INFORMED" Then
collShapes.Item(i).CellsSRC(visSectionProp, n, visCustPropsSortKey).FormulaU = "5"
Else

End If

Else
'If it does not exist
End If

Next n

'Change Prop.RISKID

For n = 0 To 30

If collShapes.Item(i).CellsSRCExists(visSectionProp, n, visCustPropsLabel, False) = -1 Then
If collShapes.Item(i).CellsSRC(visSectionProp, n, visCustPropsValue).RowNameU = "RISKID" Then
collShapes.Item(i).CellsSRC(visSectionProp, n, visCustPropsSortKey).FormulaU = "6"
Else

End If

Else
'If it does not exist
End If

Next n
'**************** copy the below*******************
'Change Prop.RiskRating1

For n = 0 To 30

If collShapes.Item(i).CellsSRCExists(visSectionProp, n, visCustPropsLabel, False) = -1 Then
If collShapes.Item(i).CellsSRC(visSectionProp, n, visCustPropsValue).RowNameU = "RiskRating1" Then
collShapes.Item(i).CellsSRC(visSectionProp, n, visCustPropsSortKey).FormulaU = "7"
Else

End If

Else
'If it does not exist
End If

Next n
'*********************Up to here********************

'*********************And insert it here***************
'add more checks here
'*************************************************
'Next item in collection

Next i

'// Undo changes if not required
   
Application.EndUndoScope UndoScopeID1, True

Exit Sub

'// Prompt error if shape not found

Err:
MsgBox ("An error occoured, are you sure all selected shapes meet the requirements for the preformed action?")
'// Changes accepted

Application.EndUndoScope UndoScopeID1, False

End Sub

Visio Guy

#11
Tip #1

To test if a cell exists (especially named cells like User, Prop, Action...)

Use CellExists, not CellsSRCExists:



If shp.CellExists("Prop.INFORMED.Sort", Visio.VisExistsFlags.visExistsAnywhere) Then

  shp.Cells("Prop.INFORMED.Sort") = Chr ( 34 ) & "10" & Chr ( 34 )

End If



You can't guarantee the index of named cells, so SRC doesn't make sense.
For articles, tips and free content, see the Visio Guy Website at http://www.visguy.com
Get my Visio Book! Using Microsoft Visio 2010

Visio Guy

Tip #2

Create a Function or a Sub to do your dirty work:



Sub SetNamedCell(ByRef shp as Visio.Shape, ByVal cellname as String, ByVal cellVal as String)

  If shp.CellExists(cellname, Visio.VisExistsFlags.visExistsAnywhere) Then

    shp.Cells(cellname) = Chr ( 34 ) & cellVal & Chr ( 34 )

  End If

End Sub

Sub Main

  ' This is a 'higher-level' procedure, where you call SetNamedCell from.
  '
  ' Set up your shape variable somewhere, somehow... 
  Set shp = Visio.ActiveWindow.Selection.Item(1)

  Call SetNamedCell( shp, "Prop.RISKID.Sort", "Orange" )
  Call SetNamedCell( shp, "Prop.INFORMED.Sort", "Banana" )
  Call SetNamedCell( shp, "Prop.ACCOUNTABILITY.Sort", "Apple" )

End Sub

For articles, tips and free content, see the Visio Guy Website at http://www.visguy.com
Get my Visio Book! Using Microsoft Visio 2010

Lars-Erik

Both make the code somewhat less cluttered, is there a nice way to fix the way it scans for the first 30 properties?
Think there should be a way to check the amount of properties or something?  kinda useless and wasting to check all of them and conclude that the last 20 don't exists.  Even though it wont run all the code if there not there....

- Lars