Visio Guy

Visio Discussions => Programming & Code => Topic started by: jeremy on October 23, 2011, 01:50:15 PM

Title: VBA: For Each Shape in Specific Layers
Post by: jeremy on October 23, 2011, 01:50:15 PM

Hello all, I have a building plan I did to scale with similar types of shapes assigned to different layers.  By isolating the building envelope, lights, and light switches I have a lighting plan.  By isolating the building envelope, electrical outlets and appliances I have a electric plan.  My problem is that because everything is actual size the smaller things like outlets and network drops are too small to see easily when printing.

My short ask would be assistance to creating a macro which would increase the size of all the objects on a single layer.  I have been only successful effecting all objects on all layers (both visible and invisible).  Here is logically what I want to do (note that swapping the commented line with the following for loop will result in every object being affected and that the uncommented for will also effect all objects):

    Dim shpObj As Shape
    On Error Resume Next

''    For Each shpObj In ActivePage.Shapes
    For Each shpObj In ActivePage.Layers("Power Outlets").Page.Shapes
        shpObj.Cells("Width") = 48
        shpObj.Cells("Height") = 32
        shpObj.Cells("Char.Size") = "12pt."
    Next shpObj

I have tried a lot of other variations based on selecting the layer objects and trying to work off of shapes only selected, looping through all the layers that a shape belongs to to see if one of those layers match the target one.  I have not been successful yet and appreciate any help.  Thank you in advance, -Jeremy

Title: Re: VBA: For Each Shape in Specific Layers
Post by: JuneTheSecond on October 23, 2011, 11:06:50 PM

I feel the layer object in Visio is not well structured.
The sample VBA code at
http://visio.mvps.org/VBA/default.html
would be a help.

Another example in short hand would be

Code

Option Explicit

Public Sub LayersContent2()
    Dim PagObj As Visio.Page
    Dim layersObj As Visio.Layers, layerObj As Visio.Layer
    Dim shpsObj As Visio.Shapes, shpObj As Visio.Shape
    Dim I As Long, N As Long
    
    For Each PagObj In ActiveDocument.Pages
        For Each shpObj In PagObj.Shapes
            N = shpObj.LayerCount
            If N > 0 Then
                For I = 1 To N
                    Set layerObj = shpObj.Layer(I)
                    If layerObj.Name = "A" Then
                        shpObj.Cells("Width").Result(visMillimeters) = 60
                    End If
                Next I
            End If
        Next shpObj
    Next PagObj
End Sub

Title: Re: VBA: For Each Shape in Specific Layers
Post by: jeremy on October 24, 2011, 08:09:57 AM

Verified that this works for me in Visio 2010.  Thank you very much!

-Jeremy