We're runing Visio 2000 Tech Edition. We want to set the Fill Colour
for each shape in a given Layer. The layer properties allows us to
change line and text colour but removes Fill colour.
We've been playing with the below code as a starting point (obtained
from other postings). This loops through all the shapes in each layer
and output the layer name and the number of shapes in each layer.
However this doesnt seem to be working properly as it seems to print
out the total number of shapes regardless of layer (see the below
output)
I am new to VBA and Visio so any help appreciated
Code....
Dim pagObj As Visio.Page
Dim layersObj As Visio.Layers
Dim layerObj As Visio.Layer
Dim shpsObj As Visio.Shapes
Dim i1, count As Integer
Set pagObj = ActiveDocument.Pages(1)
Set layersObj = pagObj.Layers
For Each layerObj In layersObj
Set shpsObj = layerObj.Page.Shapes
For i1 = 1 To shpsObj.count
count = count + 1
Next i1
Debug.Print layerObj.Name; " "; count
' reset the counter
count = 0
Next
Output...
Lisa_Layer 550
Civil Site Work 550
Irrigation System 550
Warehouse Equipment 550
Machines 550
Notations 550
Title and Key 550
Zone 1 550
Zone 2 550
Fire Wallet 3 (flammable-blue) 550
Fire Wallet 3 (harmful-purple) 550
Fire Wallet 3 (toxic-red) 550
Fire Wallet 1 (access & egress) 550
Solvent tanks 550
Fire Wallet 1 (water supplies) 550
Hydrants 550
Fire Wallet 5 (alarm zone3-yel) 550
Fire Wallet 5 (alarm zone 2-k) 550
Fire Wallet 5 (alarm zone 1-bl) 550
Fire Wallet 5 (alarm zone 4-pu) 550
this is from dvs.pdf
Use the LayerCount property of a Shape object to get the
total number of layers to
which the shape is assigned, and then use the Shape
object's Layer property to get a
particular layer. For example, this statement gets the
second layer to which the shape
is assigned:
Check the properties of the Layer object, such as Name, to
find out more about that
layer.
If the shape is not assigned to any layer, its LayerCount
property returns 0, and get-ting
its Layer property will cause an error.
Set layerObj = shpObj.Layer(2)
>.
>
First: Please show us your full name !
Try this:
Dim oPage As Visio.Page
Dim layersObj As Visio.Layers
Dim layerObj As Visio.Layer
Dim oShapes As Visio.Shapes
Dim oShp As Visio.Shape
Dim ii As Integer
Dim iCount As Integer
'
Set oPage = ActiveDocument.Pages(1)
Set layersObj = oPage.Layers
For Each layerObj In layersObj
iCount = 0
Set oShapes = layerObj.Page.Shapes
For Each oShp In oShapes
For ii = 1 To oShp.LayerCount
If oShp.Layer(ii).Name = layerObj.Name Then
iCount = iCount + 1
End If
Next
Next
Debug.Print layerObj.Name & " " & iCount
Next
--
Regards
Peter Suter
Ing.
CH 3255 Rapperswil BE