Thomas Woehlke
asked on
Using VBA to reorganize the order of layers on pages in Visio
Hello,
I'm currently trying to unify the layers across all pages in a document using a VBA module. So far I can duplicate all layers in an existing document, but after I do that the orders of the layers on each page is different based on what layers where there prior to running the script. By any chance is there an easy way to reorder layers on a page? I'm worried the answer to this is no, and I'm going to need to make a script that will catalog all the shapes on the page and what layer they are on so I can then delete the layers and recreate them in the order I want. : /
In essence, what I'm trying to do is make the shapesheets for the pages in the document display the orders of the layers consistently throughout the document.
The code I'm currently using to match all the layers is as follows.
I'm currently trying to unify the layers across all pages in a document using a VBA module. So far I can duplicate all layers in an existing document, but after I do that the orders of the layers on each page is different based on what layers where there prior to running the script. By any chance is there an easy way to reorder layers on a page? I'm worried the answer to this is no, and I'm going to need to make a script that will catalog all the shapes on the page and what layer they are on so I can then delete the layers and recreate them in the order I want. : /
In essence, what I'm trying to do is make the shapesheets for the pages in the document display the orders of the layers consistently throughout the document.
The code I'm currently using to match all the layers is as follows.
Sub LayerControl()
Dim layerCollection As Collection
Set layerCollection = Nothing
Dim documentPages As Visio.pages
Dim pagePoint As Visio.Page
Dim layerPoint As Visio.Layer
Dim layerList As Visio.Layers
Dim allLayerList As Visio.Layers
Dim counting As Integer
counting = 0
Set layerCollection = New Collection
Set documentPages = Visio.ActiveDocument.pages
For Each pagePoint In documentPages
For Each layerPoint In pagePoint.Layers
If Contains(layerCollection, layerPoint) = False Then
layerCollection.Add layerPoint, layerPoint.Name
End If
counting = counting + 1
Next layerPoint
Next pagePoint
For Each pagePoint In documentPages
For Each Item In layerCollection
pagePoint.Layers.Add Item.Name
Next Item
Next pagePoint
End Sub
Private Function Contains(col As Collection, key As Variant) As Boolean
On Error Resume Next
col (key)
Contains = (Err.Number = 0)
Err.Clear
End FunctionASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Nice work! Thanks for posting your solution back here.
The collection code you found and used is fairly remarkable -- it's designed to handle a significant range of possibilities for data and object types. I'm not about to suggest you replace it, but thought I'd mention that because you're working with a specific case here -- an alphabetic list of layer names -- simpler code is quite possible. (At a guess, you could probably accomplish the equivalent in about two dozen lines of code.)
Two other observations:
1) I'm a big fan of including 'Option Explicit' as the first line in every VBA module. Option Explicit forces you to declare every variable and object, which prevents you from accidentally using a variable you haven't defined and causing unexpected results. In your sub, for example, Item and Page are undeclared. In this case it's fine, because their usage is very clear in the context of the For/Next loops. But it's very easy to accidentally misspell a variable name and end up with an error.
2) Be careful with the code loop that deletes all of the shapes from your transfer page -- the technique you're using can fail. Rather than tell you why, I'll leave it to my articulate friend Chris Roth: refer to this article of his, especially under the heading "Deleting Shapes One by One – The Wrong Way."
I'll apologize in advance if this is unwanted extra advice, but I thought I'd throw it out there...
The collection code you found and used is fairly remarkable -- it's designed to handle a significant range of possibilities for data and object types. I'm not about to suggest you replace it, but thought I'd mention that because you're working with a specific case here -- an alphabetic list of layer names -- simpler code is quite possible. (At a guess, you could probably accomplish the equivalent in about two dozen lines of code.)
Two other observations:
1) I'm a big fan of including 'Option Explicit' as the first line in every VBA module. Option Explicit forces you to declare every variable and object, which prevents you from accidentally using a variable you haven't defined and causing unexpected results. In your sub, for example, Item and Page are undeclared. In this case it's fine, because their usage is very clear in the context of the For/Next loops. But it's very easy to accidentally misspell a variable name and end up with an error.
2) Be careful with the code loop that deletes all of the shapes from your transfer page -- the technique you're using can fail. Rather than tell you why, I'll leave it to my articulate friend Chris Roth: refer to this article of his, especially under the heading "Deleting Shapes One by One – The Wrong Way."
I'll apologize in advance if this is unwanted extra advice, but I thought I'd throw it out there...
ASKER
Any advise for best practice is appreciated. Unfortunately almost immediately after I posted my code I realized it would not work on larger drawings with more shapes. In order to correct this I changed from copying individual shapes to selecting all shapes on an active window, then copying and pasting. I'll post that code up in the next few days. It actually looks like it will be shorter than what I did with the shapes. The only problem I'm having with it right now is the amount of shapes being copied takes a long time so I may have to write in a wait function to make the code work properly.
Here's another thought: instead of doing the time consuming copy/paste operation, why don't you simply build an array or dictionary containing a list of layers for each shape on a page. I think it would be considerably faster. Something like this logic:
For each page
For each shape in page.shapes
For each layer in shape.layers
add new layer to layer list for this shape
Next layer
Next shape
delete all layers
add layers in sorted sequence
For each shape in page.shapes
For each layer in layer list
add shape to layer
Next layer
Next shape
Next page
My inclination would be to use a Dictionary object to store the layer list, using NameID as the key for each dictionary entry and build a semicolon separated list of layer names for the value entry. I can throw some sample code together if you haven't used dictionaries before. If you're interested, why don't you click the "Ask a related question" button and post a new question with a request.
For each page
For each shape in page.shapes
For each layer in shape.layers
add new layer to layer list for this shape
Next layer
Next shape
delete all layers
add layers in sorted sequence
For each shape in page.shapes
For each layer in layer list
add shape to layer
Next layer
Next shape
Next page
My inclination would be to use a Dictionary object to store the layer list, using NameID as the key for each dictionary entry and build a semicolon separated list of layer names for the value entry. I can throw some sample code together if you haven't used dictionaries before. If you're interested, why don't you click the "Ask a related question" button and post a new question with a request.
ASKER