VBA: For Each Shape in Specific Layers

Started by jeremy, October 23, 2011, 06:50:15 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

jeremy

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

JuneTheSecond

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


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


Best Regards,

Junichi Yoda
http://june.minibird.jp/

jeremy

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

-Jeremy