none
Custom Visio property to enable selection by macro RRS feed

  • Question

  • Hi,

    I have a fairly complex system architecture diagram, with lots of systems joined by different types of connector.

    I'd like to be able to use the same diagram to support various functions - i.e. architecture or service based teams. The default version has lots of text annotating the connectors. I'd like to be able to set up a macro to hide that text for certain end audience requirements. I can do this by simple grouping of the connectors, and then setting the text to 100% transparent, and the text-fill similarly. What I'd rather do, as opposed to grouping, is to be able to refer to every object with a particular attribute, so that I can then make amendments to the diagram easier, without needing to ungroup and regroup things.

    Is this possible? I am using Visio 2010 Standard. I am fine with using VBA to accomplish this - though my simple grouping macro was a straightforward 'record macro' operation.

    Thanks

    John


    Cheers, John


    Wednesday, February 17, 2016 3:21 PM

Answers

  • I've found a way to accomplish what I needed to. Would still be interested if anyone knows a slicker way to do this though? This is based upon an answer here: Stack Exchange answer

    Private Sub RemoveConnTxt()
    
        Dim shpObj As Visio.Shape, celObj As Visio.Cell
    
        Dim i As Integer, ShpNo As Integer
    
        Dim LabelName As String, ValName As String, Tabchr As String
    
        
    
        Tabchr = Chr(9)
    
        
    
        For ShpNo = 1 To Visio.ActivePage.Shapes.Count
    
            Set shpObj = Visio.ActivePage.Shapes(ShpNo)
    
            nrows = shpObj.RowCount(Visio.visSectionProp)
    
            For i = 0 To nrows - 1
    
                Set celObj = shpObj.CellsSRC(Visio.visSectionProp, i, 0)
    
                ValName = celObj.ResultStr(Visio.visNone)
    
                Set celObj = shpObj.CellsSRC(Visio.visSectionProp, i, 2)
    
                LabelName = celObj.ResultStr(Visio.visNone)
    
                If (UCase(ValName) = "TRUE") And (LabelName = "BatchConnector" Or LabelName = "OnlineConnector") Then
    
                    shpObj.CellsSRC(visSectionObject, visRowText, visTxtBlkBkgnd).FormulaU = "1"
    
                    shpObj.CellsSRC(visSectionObject, visRowText, visTxtBlkBkgndTrans).FormulaU = "100%"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterColor).FormulaU = "0"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterDblUnderline).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterOverline).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterStrikethru).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, 11).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterDoubleStrikethrough).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterRTLText).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterUseVertical).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterColorTrans).FormulaU = "100%"
    
                End If
    
            Next i
    
        Next ShpNo
    
    End Sub
    
     
    
    Private Sub RestoreConnTxt()
    
        Dim shpObj As Visio.Shape, celObj As Visio.Cell
    
        Dim i As Integer, ShpNo As Integer
    
        Dim LabelName As String, ValName As String, Tabchr As String
    
        
    
        Tabchr = Chr(9)
    
        
    
        For ShpNo = 1 To Visio.ActivePage.Shapes.Count
    
            Set shpObj = Visio.ActivePage.Shapes(ShpNo)
    
            nrows = shpObj.RowCount(Visio.visSectionProp)
    
            For i = 0 To nrows - 1
    
                Set celObj = shpObj.CellsSRC(Visio.visSectionProp, i, 0)
    
                ValName = celObj.ResultStr(Visio.visNone)
    
                Set celObj = shpObj.CellsSRC(Visio.visSectionProp, i, 2)
    
                LabelName = celObj.ResultStr(Visio.visNone)
    
                If (UCase(ValName) = "TRUE") And (LabelName = "BatchConnector" Or LabelName = "OnlineConnector") Then
    
                    shpObj.CellsSRC(visSectionObject, visRowText, visTxtBlkBkgnd).FormulaU = "THEMEGUARD(RGB(255,255,255)+1)"
    
                    shpObj.CellsSRC(visSectionObject, visRowText, visTxtBlkBkgndTrans).FormulaU = "0%"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterColor).FormulaU = "0"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterDblUnderline).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterOverline).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterStrikethru).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, 11).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterDoubleStrikethrough).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterRTLText).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterUseVertical).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterColorTrans).FormulaU = "0%"
    
                End If
    
            Next i
    
        Next ShpNo
    
    End Sub
    


    Cheers, John

    • Marked as answer by j_dublevay Friday, February 19, 2016 9:27 PM
    Thursday, February 18, 2016 12:44 PM

All replies

  • Hi John,

    This is the forum to discuss questions and feedback for Microsoft Visio, as your problem is related to Develop problem I'll move your question to the MSDN forum for General Office Development

    https://social.msdn.microsoft.com/Forums/en-US/home?forum=officegeneral

    The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us. Thank you for your understanding.


    Regards,

    Emi Zhang
    TechNet Community Support


    Please mark the reply as an answer if you find it is helpful.

    If you have feedback for TechNet Support, contact tnmff@microsoft.com.

    Thursday, February 18, 2016 7:35 AM
  • OK - thanks - have changed to subject to include Visio as well now.

    Cheers, John

    Thursday, February 18, 2016 8:55 AM
  • I've found a way to accomplish what I needed to. Would still be interested if anyone knows a slicker way to do this though? This is based upon an answer here: Stack Exchange answer

    Private Sub RemoveConnTxt()
    
        Dim shpObj As Visio.Shape, celObj As Visio.Cell
    
        Dim i As Integer, ShpNo As Integer
    
        Dim LabelName As String, ValName As String, Tabchr As String
    
        
    
        Tabchr = Chr(9)
    
        
    
        For ShpNo = 1 To Visio.ActivePage.Shapes.Count
    
            Set shpObj = Visio.ActivePage.Shapes(ShpNo)
    
            nrows = shpObj.RowCount(Visio.visSectionProp)
    
            For i = 0 To nrows - 1
    
                Set celObj = shpObj.CellsSRC(Visio.visSectionProp, i, 0)
    
                ValName = celObj.ResultStr(Visio.visNone)
    
                Set celObj = shpObj.CellsSRC(Visio.visSectionProp, i, 2)
    
                LabelName = celObj.ResultStr(Visio.visNone)
    
                If (UCase(ValName) = "TRUE") And (LabelName = "BatchConnector" Or LabelName = "OnlineConnector") Then
    
                    shpObj.CellsSRC(visSectionObject, visRowText, visTxtBlkBkgnd).FormulaU = "1"
    
                    shpObj.CellsSRC(visSectionObject, visRowText, visTxtBlkBkgndTrans).FormulaU = "100%"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterColor).FormulaU = "0"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterDblUnderline).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterOverline).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterStrikethru).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, 11).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterDoubleStrikethrough).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterRTLText).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterUseVertical).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterColorTrans).FormulaU = "100%"
    
                End If
    
            Next i
    
        Next ShpNo
    
    End Sub
    
     
    
    Private Sub RestoreConnTxt()
    
        Dim shpObj As Visio.Shape, celObj As Visio.Cell
    
        Dim i As Integer, ShpNo As Integer
    
        Dim LabelName As String, ValName As String, Tabchr As String
    
        
    
        Tabchr = Chr(9)
    
        
    
        For ShpNo = 1 To Visio.ActivePage.Shapes.Count
    
            Set shpObj = Visio.ActivePage.Shapes(ShpNo)
    
            nrows = shpObj.RowCount(Visio.visSectionProp)
    
            For i = 0 To nrows - 1
    
                Set celObj = shpObj.CellsSRC(Visio.visSectionProp, i, 0)
    
                ValName = celObj.ResultStr(Visio.visNone)
    
                Set celObj = shpObj.CellsSRC(Visio.visSectionProp, i, 2)
    
                LabelName = celObj.ResultStr(Visio.visNone)
    
                If (UCase(ValName) = "TRUE") And (LabelName = "BatchConnector" Or LabelName = "OnlineConnector") Then
    
                    shpObj.CellsSRC(visSectionObject, visRowText, visTxtBlkBkgnd).FormulaU = "THEMEGUARD(RGB(255,255,255)+1)"
    
                    shpObj.CellsSRC(visSectionObject, visRowText, visTxtBlkBkgndTrans).FormulaU = "0%"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterColor).FormulaU = "0"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterDblUnderline).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterOverline).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterStrikethru).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, 11).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterDoubleStrikethrough).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterRTLText).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterUseVertical).FormulaU = "FALSE"
    
                    shpObj.CellsSRC(visSectionCharacter, 0, visCharacterColorTrans).FormulaU = "0%"
    
                End If
    
            Next i
    
        Next ShpNo
    
    End Sub
    


    Cheers, John

    • Marked as answer by j_dublevay Friday, February 19, 2016 9:27 PM
    Thursday, February 18, 2016 12:44 PM