selfmade shortcuts in Visio 2010

Started by hidden layer, October 11, 2018, 10:56:56 AM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

hidden layer

Hi there,
neither in German or English environment I found an answer to the question:

Is it possible to create a shortcut in Visio 2010?

Actually I have to allocate hundreths of shapes to layers and always have to mouseclick layer -> add to layer... blabla.

I know, it's a more general question and I've read that it's possible to create a macro and I'm about to create one but I'm not really experienced with that. So if there is a solution out there I would appreciate any advice.

Thanks,
Peter

Paul Herber

You can do more than one shape at a time ...
But other than that ...
ribbon File  -> Options -> Quick Access Toolbar
Choose commands from: all commands
Scroll down to Assign to Layer
and click add.
The button is now on the quick access toolbar.
Electronic and Electrical engineering, business and software stencils for Visio -

https://www.paulherber.co.uk/

Yacine

#2
To extend Paul's advice, you can write a VBA form which once called lets you assign the layer to one shape after the other, or whole selections of shapes.
Make a form and add the following controls to it:

       
  • a list, name it ListValue
  • a text field, name it tValue
  • a checkbox, name it CheckAktiv
Set the showmodal value of the form to false.
And here's the code:
Option Explicit

Private WithEvents winObj As Visio.Window

Private Sub ListValue_Change()
    tValue.Value = ListValue.Value
End Sub

Private Sub UserForm_Initialize()
Dim temp As String
Dim arVals() As String
Dim f As Variant
   
    temp = "Layer1,Layer2,Layer3"
    arVals = Split(temp, ",")
    With ListValue
        For Each f In arVals
            .AddItem f
        Next f
    End With
    Set winObj = Application.ActiveWindow
End Sub

Private Sub winObj_SelectionChanged(ByVal Window As IVWindow)
    Dim shp As Visio.Shape
    Dim sel As Visio.Selection
    Set sel = ActiveWindow.Selection
    sel.IterationMode = visSelModeSkipSuper
    If sel.Count > 0 And CheckAktiv.Value Then
        For Each shp In sel
            setValue shp, tValue.Value
        Next shp
    End If
End Sub

Private Function setValue(shp As Visio.Shape, layerName As String)
    n = ActivePage.Layers(layerName).Index
    shp.Cells("layerMember").FormulaU = Chr(34) & n - 1 & Chr(34)
End Function


Note:

       
  • the layer names are hard coded. Change them to your needs or write something more dynamic.
  • the layer is only assigned if the checkbox is checked. This way you can uncheck the checkbox, do something else, recheck and resume the assigning process
  • the routine works with both single shapes and whole selections
  • the listbox is there to let you chose which layer to assign
I use this tool on a daily basis - not for layers, but to populate prop fields.

Viel Erfolg,
Y.
Yacine

hidden layer

#3
Hi Paul,
yes, the 'button' Assign to layer is already at the toolbar. The toolbar is meanwhile a bit huge...

@yacine:
Thanks a lot!
I've changed the script like this and that works great!
    Set winObj = Application.ActiveWindow
ListValue.Clear
For Each laylayer In ActivePage.Layers
    laylist = laylist & laylayer.Name & ","
Next
laylist = Left(laylist, Len(laylist) - 1)
    arVals = Split(laylist, ",")
    With ListValue
        For Each f In arVals
            .AddItem f
        Next f
    End With


Writing code is a Little bit different from Excel but it's not rocket science  ;)

Thanks a lot!!

Peter

But back to the question: is it possible to create own shortcuts? (as we know it from others)

Yacine

Yacine

hidden layer

#5
hi there,
inbetween I've worked with the list. The first was to add a functionality to sort the list alphabetically. Y'know- you add layers later and due to a late index they appear anywhere at the end.
The userform owns now 2 listboxes with MultiSelectMulti and a CommandButton (and some Labels).
The width of the ListBox depends on the layer's names.
The second is to choose the layer from ListBox2 (only!) and 'update' the shape's properties by pushing the button.

Currently it's for a single shape only- feel free to edit it.
The code is here - for whom it may interest.
Option Explicit
Private WithEvents winObj As Visio.Window

Private Sub sort()
ListBox1.BackColor = &H80000000
ListBox2.BackColor = &HFFFFFF
Dim i As Integer, j As Integer
    i = ListBox1.ListCount
Dim laylist As String
Dim laylayer As Layer
Dim arLay() As String
Dim lIndex      As Long
Dim lCount      As Long
Dim fa As Variant
Dim fb As Variant

Set winObj = Application.ActiveWindow
With ListBox1
        If .ListCount > 0 Then
            lIndex = -1
            For lCount = 0 To .ListCount - 1
                'If .Selected(lCount) = True Then
                    lIndex = lIndex + 1
                    ReDim Preserve arLay(lIndex)
                    arLay(lIndex) = .List(lCount)
                'End If
            Next
        End If
    End With
QuickSort_Feld arLay, 0, lIndex, False
With ListBox2
    lIndex = -1
    For lCount = 0 To i - 1
            lIndex = lIndex + 1
            fa = Left(arLay(lCount), InStr(1, arLay(lCount), "-") - 1)
            fb = Mid(arLay(lCount), InStr(1, arLay(lCount), "-") + 1, Len(arLay(lCount)) - InStr(1, arLay(lCount), "-"))
            .AddItem fa
            .List(.ListCount - 1, 1) = fb
    Next
End With

End Sub

Private Sub CommandButton1_Click()
Dim a As String: a = Chr(34)
Dim b As String
Dim shp As Visio.Shape
Dim lay As Layer
Dim n
Dim sel As Visio.Selection
    Set sel = ActiveWindow.Selection
    sel.IterationMode = visSelModeSkipSuper
Dim listc As Integer
    listc = ListBox2.ListCount
Dim i As Integer
    For i = 0 To listc - 1
        If ListBox2.Selected(i) = True Then
            n = ListBox2.List(i, 1) - 1
            a = a & n & Chr(59)
        End If
    Next i

a = Left(a, Len(a) - 1)
a = a & Chr(34)

If sel.Count = 1 Then
    For Each shp In sel
        shp.Cells("layerMember").FormulaU = a
    Next shp
End If
End Sub

Private Sub UserForm_Initialize() 'Layer auslesen

Dim temp As String
Dim arVals() As String
Dim f As Variant
Dim fa As Variant
Dim fb As Variant
Dim laylist As String
Dim laylayer As Layer
Dim arLay() As String

ListBox2.BackColor = &H80000000
ListBox1.BackColor = &HFFFFFF
Set winObj = Application.ActiveWindow
ListBox1.Clear
For Each laylayer In ActivePage.Layers
    laylist = laylist & laylayer.Name & "-" & laylayer.Index & ","
Next
laylist = Left(laylist, Len(laylist) - 1)

    arVals = Split(laylist, ",")
    With ListBox1
        For Each f In arVals
            .AddItem f
        Next f
    End With
sort

End Sub
Private Sub QuickSort_Feld(DasFeld, StartUnten, EndeOben, Absteigend As Boolean)
    'QuickSort Standard
    Dim iUnten As Long, iOben, iMitte, y
    iUnten = StartUnten
    iOben = EndeOben
    iMitte = DasFeld((StartUnten + EndeOben) / 2)
    While (iUnten <= iOben)
       If Not Absteigend Then
          While (DasFeld(iUnten) < iMitte And iUnten < EndeOben)
             iUnten = iUnten + 1
          Wend
          While (iMitte < DasFeld(iOben) And iOben > StartUnten)
             iOben = iOben - 1
          Wend
       Else
          While (DasFeld(iUnten) > iMitte And iUnten < EndeOben)
             iUnten = iUnten + 1
          Wend
          While (iMitte > DasFeld(iOben) And iOben > StartUnten)
             iOben = iOben - 1
          Wend
       End If
       If (iUnten <= iOben) Then
          y = DasFeld(iUnten)
          DasFeld(iUnten) = DasFeld(iOben)
          DasFeld(iOben) = y
          iUnten = iUnten + 1
          iOben = iOben - 1
       End If
    Wend
    If (StartUnten < iOben) Then Call QuickSort_Feld(DasFeld, StartUnten, iOben, Absteigend)
    If (iUnten < EndeOben) Then Call QuickSort_Feld(DasFeld, iUnten, EndeOben, Absteigend)
End Sub
Private Sub winObj_SelectionChanged(ByVal Window As IVWindow)
Dim shp As Visio.Shape
Dim x As String
Dim a As Variant
Dim b As Integer
Dim c As String
Dim i As Integer
Dim j As Integer
Dim listc As Integer
Dim abc() As String
Dim layla As Layer

listc = ListBox1.ListCount
    For i = 1 To listc
        ListBox1.Selected(i - 1) = False
        ListBox2.Selected(i - 1) = False
    Next i
   
    Dim sel As Visio.Selection
    Set sel = ActiveWindow.Selection
    sel.IterationMode = visSelModeSkipSuper
    If sel.Count > 1 Then
        MsgBox "Please select only one shape."
    ElseIf sel.Count > 0 Then
        For Each shp In sel
        If shp.Cells("layerMember").FormulaU = "" Then Exit Sub
            x = shp.Cells("layerMember").FormulaU '"a;b;c..." ein Wort
            x = Left(x, Len(x) - 1) 'rechtes Anführungszeichen löschen
            x = Right(x, Len(x) - 1) 'linkes Anführungszeichen löschen
            abc = Split(x, ";")
            i = 1
            With ListBox1
                For Each a In abc 'für jeden Layer des Objekts
                b = a * 1 ' eine Zahl draus machen
                Set layla = shp.Layer(i)
                c = layla.Name ' den Namen aus dem Index ermitteln
                .Selected(b) = True 'in der Liste markieren
                i = i + 1 'nächster Layer
                Next a
            End With
            i = 1
            j = 1
            With ListBox2
                For Each a In abc 'für jeden Layer des Shapes
                b = a * 1 'Zahl
                Set layla = shp.Layer(i)
                c = layla.Name '  c = Name des Layer
               
                For j = 1 To ListBox2.ListCount ' alle listeneinträge durchgehen
                    If .List(j - 1, 0) = c Then 'wenn der Name in der Liste gleich Name Layer ist
                        ListBox2.Selected(j - 1) = True
                    End If
                Next j
                i = i + 1
                Next a
               
            End With
        Next shp
    End If
End Sub

sorry for German comments- it should be clear what happens.. it's just a remark for later use (as always).

a Special thank to Yacine for pushing into the right direction.

Peter