[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 512
  • Last Modified:

How can I add a selected shape to a layer from a combobox?

Hello,

I created a combo box that lists all of the existing layers on the active page.

I have been able to create a macro that will add selected shapes to a layer which is specified in the combo box.

I am trying to create a macro that will hide the layer that is selected in the combo box. I am receiving an error at this line:

Sub HideLayer
-> Set objLayer = objLayers(Layername)

I have a feeling that I should be using a different syntax since I need to use FormulaU to toggle the layer's visibility, but I don't know what it would be.

Any suggestions?

Thank you!!
Kyle


Private Sub ComboBox1_DropButtonClick()
Dim lngCurSel As Long
 
'Save Current selection
lngCurSel = ComboBox1.ListIndex
 
'Remove items or we will keep adding them over an over...
ComboBox1.Clear
 
 
'Loop Comboxbox1.additem ("Layer Name") for each layer
For i = 1 To ActivePage.Layers.Count
    
    Dim Layername
    Layername = ActivePage.Layers.Item(i).Name
    
    ComboBox1.AddItem Layername
    
Next
 
 
'Reset the selection
ComboBox1.ListIndex = lngCurSel
 
End Sub
 
 
 
Sub AddToLayer()
 
Dim UndoScopeID1 As Long
UndoScopeID1 = Application.BeginUndoScope("Layer")
 
 
Dim objShps As Visio.Selection, objShp As Visio.Shape
Dim objLayers As Visio.Layers, objLayer As Visio.Layer
Dim i As Integer
 
'get the Selection
Set objShps = Visio.ActiveWindow.Selection
 
Dim Layername
Layername = ThisDocument.ComboBox1.Value
MsgBox Layername
 
'get the layers collection
Set objLayers = Visio.ActivePage.Layers
Set objLayer = objLayers(Layername)
 
For i = 1 To objShps.Count
Set objShp = objShps(i)
objLayer.Add objShp, 0
 
Next i
 
End Sub
 
 
 
 
 
 
 
Sub HideLayers()
 
    Dim UndoScopeID1 As Long
    UndoScopeID1 = Application.BeginUndoScope("Layer Properties")
    
    Dim Layername
    Layername = ThisDocument.ComboBox1.Value
    MsgBox Layername
    
 
    Set objLayers = Visio.ActivePage.Layers
    Set objLayer = objLayers(Layername)
    
    If objLayer.CellsC(visLayerVisible).FormulaU = "1" Then
    objLayer.CellsC(visLayerVisible).FormulaU = "0"
    Else
    objLayer1.CellsC(visLayerVisible).FormulaU = "1"
    End If
    
    Application.EndUndoScope UndoScopeID1, True
 
End Sub

Open in new window

0
khott2003
Asked:
khott2003
2 Solutions
 
Scott HelmersVisio Consultant, Trainer, Author, and DeveloperCommented:
Is it as simple as the fact that you haven't defined the objects? AddToLayer() includes
   Dim objShps As Visio.Selection, objShp As Visio.Shape
   Dim objLayers As Visio.Layers, objLayer As Visio.Layer
but you don't have those definitions in HideLayers(), consequently, the set will fail.

One other observation, the IF...ELSE in HideLayers() has two different object names:
   objLayer and objLayer1
Don't let that bite you.
0
 
khott2003Author Commented:
That fixed it. Sometimes it's the little things.... Thanks!
Sub HideLayers()
 
    Dim objShps As Visio.Selection, objShp As Visio.Shape
    Dim objLayers As Visio.Layers, objLayer As Visio.Layer
 
    Dim UndoScopeID1 As Long
    UndoScopeID1 = Application.BeginUndoScope("Layer Properties")
    
    Dim Layername
    Layername = ThisDocument.ComboBox1.Value
    MsgBox Layername
    
 
    Set objLayers = Visio.ActivePage.Layers
    Set objLayer = objLayers(Layername)
    
    If objLayer.CellsC(visLayerVisible).FormulaU = "1" Then
    objLayer.CellsC(visLayerVisible).FormulaU = "0"
    Else
    objLayer.CellsC(visLayerVisible).FormulaU = "1"
    End If
    
    Application.EndUndoScope UndoScopeID1, True
 
End Sub

Open in new window

0

Featured Post

[Webinar] Cloud and Mobile-First Strategy

Maybe you’ve fully adopted the cloud since the beginning. Or maybe you started with on-prem resources but are pursuing a “cloud and mobile first” strategy. Getting to that end state has its challenges. Discover how to build out a 100% cloud and mobile IT strategy in this webinar.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now