Sort the "Assign to Layer" list

[wapperdude]

YIKES

Paul Herber spotted a problem.  Sorting the names does not include moving the various properties with them.  That is definitely bad!!!  So, each original row needs to be placed in an array, wuch that property values track with layer name.  Then after sorting, both the layer name and its properties and entered back into the shapesheet.

Ah.  Close but no cigar!

[Surrogate]

Then after sorting, both the layer name and its properties and entered back into the shapesheet.

IMHO it is impossible ! In the ShapeSheet, layers are sorted as they are added to the sheet. We can't re-order this list !

[wapperdude]

I'd say, nearly impossible. 

Besides the issue that Paul observed, there is one more issue.  For each shape, the list of assigned layers is based upon layer position, not layer name.  So, ialphabetizing the names changes the layer that they represent.  That is, if originally, 4th layer, had name "A", but after sorting, "A" is first layer, i.e. layer "0".  A new shape, assigned to "A" is actually point to a different layer than a previously assigned shape with layer A.  So, if previous shape, layer "A" would show up as "3" in its shapesheet, but in a new shape, after sorting, layer "A" would be listed as "0".  This is a total mess!!! 

Not only do you have to move the layer properties with the layer names, but you must, additionally, unassign and re-assign  the layers for each shape.  Thus, this become a much more involved task.  But, not impossible.  Unfortunate. 

[Surrogate]

Not only do you have to move the layer properties with the layer names, but you must, additionally, unassign and re-assign  the layers for each shape.  Thus, this become a much more involved task.  But, not impossible.

+1 !
Another point that complicates things a bit.
The layer numbers in the Page's PageSheet start with 1.
And for the shapes in the LayerMembership cell, the layer numbers start with 0.

[Paul Herber]

 ... and any other formulae that refers to the layers cells, could even be on other pages, unlikely but possible.

[Yacine]

If I understood the original post correctly, the poster is complaining about not having the layers in alphabetical order when assigning layers to the shapes.
There is no request for ordering the layer structure itself.
A simple assigning form with Wapperdude's sorted list should suffice for the task.


I'm myself busy on another project, but any other "helper" or the poster himself can set this up very easily.

[wapperdude]

@Yacine:  Strictly speaking, you're correct.  But, to change the order of names only has some issues.  As this was done via the page's shapesheet, the technique doesn't cause the layer properties to track with the name.  Plus, it doesn't change the delineated list of layer row assignments within a shape's shapesheet.  That means there are multiple places of erroneous, confusing info.

For what it doesn't do,  I do not recommend using this macro. 

[Yacine]

Hi Wayne,
I did not explain myself properly and I saw it in your code.
You were trying to order the layers themselves. With the possible advantage of re-using the original layers dialog. Difficult ... for many reasons.
What I am saying, is that it is absolutely legit to use an auxiliary form which displays the layers in alphabetical order.
The assignment would however not be the name but the index of this layer, stored in a second column of the list.


I modified your code a little bit, in so far as it does not modify the layers, but returns a sorted array of tuples (layer name, layer index). I then use this array to populate a list.
The list will have the layer name as first column and the index as a second one. The bound column will be the second as to return only the index.

Code of helper routine:

Code

Option Explicit

Sub showForm()
    formAssignToLayer.Show
End Sub

Sub createLayers()
    Dim lyr As Layer
    Dim pg As Page
    Dim i As Integer
    Dim j As Integer
    Dim t As String
    
    Set pg = ActivePage
    
    For i = 1 To 100
        t = ""
        Do
            t = t & Chr(65 + Int(Rnd * 26))
        Loop Until Rnd > 0.9
        pg.Layers.Add t
    Next i
End Sub


Sub deleteAllLayers()
    Dim lyr As Layer
    Dim pg As Page
    Dim i As Integer
    
    Set pg = ActivePage
    pg.PageSheet.DeleteSection visSectionLayer
End Sub


Function Bubble_SortArray() As Variant
'Alphabetize order of layers '
'An approach that eliminates need to open Page shapesheet '


    Dim tmpStr As String
    Dim pgLyrs As Visio.Layers
    Dim pgLyr As Layer
    Dim arrLyrs() As Variant
    Dim RCnt As Long
    Dim i As Long, j As Long
    
    Dim vShp As Visio.Shape
    Dim vShps As Visio.Shapes
    Dim actPg As Visio.Page
    
'Initializations '
    Set actPg = ActivePage
    Set vShps = actPg.Shapes
    Set vShp = vShps("ThePage")
    
    Set pgLyrs = actPg.Layers
    RCnt = pgLyrs.Count
    If RCnt = 0 Then
        Exit Function
    End If
    ReDim arrLyrs(RCnt - 1)
    i = LBound(arrLyrs)
    
'Fetch all the layer names & store in array '
    For Each pgLyr In pgLyrs
        arrLyrs(i) = pgLyr.Name & "|" & pgLyr.Index
        i = i + 1
    Next


'Alphabetize Sheet Names in Array List '
    For i = LBound(arrLyrs) To UBound(arrLyrs)
        For j = i To UBound(arrLyrs)
            If UCase(arrLyrs(j)) < UCase(arrLyrs(i)) Then
                tmpStr = arrLyrs(i)
                arrLyrs(i) = arrLyrs(j)
                arrLyrs(j) = tmpStr
            End If
        Next j
    Next i
    
'Transfer corrected sequence to the page shapesheet '
    Bubble_SortArray = arrLyrs
End Function


Sub testBubbleSortArray()
    Dim arLyrs As Variant
    Dim lyr As Variant
    Dim v As Variant
    Dim t1 As String, t2 As String
    Dim lyr_num As Integer
    
    arLyrs = Bubble_SortArray
    If IsEmpty(arLyrs) Then
        Exit Sub
    End If
    For Each lyr In arLyrs
        v = Split(lyr, "|")
        t1 = v(0)
        t2 = v(1)
        Debug.Print t1, t2
    Next lyr
End Sub

That's it. Now assign this number to the selection's membership and you're done.

Code of the form:

Code

Option Explicit

Public currentLyr As Layer

Sub populateLayersList()

    Dim arLyrs As Variant
    Dim lyr As Variant
    Dim v As Variant
    Dim t1 As String, t2 As String
    Dim lyr_num As Integer
    
    listLyrs.Clear
    
    arLyrs = Bubble_SortArray
    If IsEmpty(arLyrs) Then
        Exit Sub
    End If
    For Each lyr In arLyrs
        v = Split(lyr, "|")
        t1 = v(0)
        t2 = v(1)
        listLyrs.AddItem
        listLyrs.List(listLyrs.ListCount - 1, 0) = t1
        listLyrs.List(listLyrs.ListCount - 1, 1) = t2
    Next lyr
End Sub

Private Sub cmAssign_Click()
    Dim shp As Shape
    Dim lyr_num As Integer
    
    lyr_num = listLyrs.Value - 1
    Debug.Print lyr_num
    For Each shp In ActiveWindow.Selection
        shp.CellsSRC(visSectionObject, visRowLayerMem, visLayerMember).FormulaForceU = Chr(34) & Str(lyr_num) & Chr(34)
    Next shp
End Sub

Private Sub cmUpdate_Click()
    populateLayersList
End Sub


Private Sub listLyrs_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Set currentLyr = ActivePage.Layers.Item(Int(listLyrs.Value))
    Debug.Print currentLyr.Name, currentLyr.Index
    formEditLayer.Show
    formEditLayer.refresh
End Sub

Private Sub UserForm_Initialize()
    populateLayersList
End Sub

I was procrastinating enough to find the time to add a form for editing a layer's properties. But it is only a stub.


P.S.: You may argument that the sorting is not perfect. I sort over "name"|"index", which may result in slightly disrupted sort orders. Fine enough for the purpose of this post.
An optimized sorting would require a sorting over the names only and the subsequent addition of the index. ... an aesthetical problem.

[wapperdude]

@Yacine:  Got it.  Nice.  My bad...you did mention early on of creating a separate form.  I forgot.