Visio 中的切换按钮引用

Question

我正在尝试在 VBA 中设置切换按钮的格式。我有 80 多个按钮，每个按钮都打开/关闭图层，我正在尝试整理它。格式化是在“点击”级别完成的，但这会造成大量重复。

Sub A2_Click() 
    Dim LyrNum As Integer ' Layer Number
    Dim RiserName As String
        LyrNum = A2.Data1 ' Pulled for Data1 field
        RiserName = "A2"
    If A2 Then            ' Button down
        Call ToggleRiser(LyrNum, 1, RiserName) ' Call Sub with Layer Number and "On"
      Else
        Call ToggleRiser(LyrNum, 0, RiserName) ' Call Sub with Layer Number and Off
   End If
End Sub

理想情况下调用：

Sub ToggleRiser(ItmNbr As Integer, OnOff As String, Riser As Object)  ' Sub to switch layers on and off - ItmBr is the Layer Number; Riser is the Toggle Button Name

    Dim vsoLayer1 As Visio.Layer            ' Create Variable for Layer Info
    Set vsoLayer1 = Application.ActiveDocument.Pages.ItemU("Filler Boxes, Half Risers and Bass Box Layers").Layers.Item(ItmNbr) ' Set to specific Layer called
    
      
    If OnOff Then            ' Button down
        Riser.BackColor = RGB(230, 180, 50) ' Change Background Yell
    Else
        Riser.BackColor = RGB(129, 133, 219) ' Dark Blue
    End If
    
    vsoLayer1.CellsC(visLayerVisible).FormulaU = OnOff                                                 ' 
    vsoLayer1.CellsC(visLayerPrint).FormulaU = OnOff                                                   ' 

打开和关闭图层是有效的，但我遗漏了

Riser.BackColor

的一些内容，因为 VBA 没有将其识别为

A2.BackColor

。

我需要将“Riser”评估为与字符串不同的东西吗？

示例文件： https://www.dropbox.com/s/io1nwnkmhs0a28c/ToggleScriptExample.vsdm?dl=0

理想情况下，我想将按钮格式移到 ToggleLayer Sub 中，或者总体上找到更好的方法。

Answer 1

我的家用计算机上没有 Visio，因此我无法检查示例文件或验证其中任何内容是否确实有效。

正如 OP 推测的那样，我们需要将 Riser 作为对象而不是字符串传递。将呼叫更改为

Call ToggleRiser(LyrNum, 1, A2)

应该可以解决问题。不过，我们可以直接从 Riser 中提取我们需要的所有数据，以简化代码：

Sub A2_Click() 
   Call ToggleRiser(A2)  ' Call Sub with Riser
End Sub

Sub ToggleRiser(ByRef Riser As Object)  ' Sub to switch layers on and off
    Dim vsoLayer As Visio.Layer            ' Create Variable for Layer Info
    Set vsoLayer = ActiveDocument.Pages("Filler Boxes, Half Risers and Bass Box Layers").Layers(Riser.Data1)
    
    'Toggle Layer
    vsoLayer.CellsC(visLayerVisible).FormulaU = Riser.Value                                                 
    vsoLayer.CellsC(visLayerPrint).FormulaU = Riser.Value

    'Color Riser
    If Riser.Value Then                     ' Button down
        Riser.BackColor = RGB(230, 180, 50)  
    Else
        Riser.BackColor = RGB(129, 133, 219)
    End If
End Sub

---

也就是说，我们可以通过使用 Wrapper Class 来处理 all 的 Risers 来做得更好，而不会在硬编码的 Click 事件上浪费空间。

首先，创建一个类，我将其称为

RiserWrapper

。它有一个通用的启用事件的 ToggleButton，我们可以将一个 Riser 传递给它，以捕获所有的点击事件。

Public WithEvents mRiser as MSForms.ToggleButton 'The passed Riser is event-enabled

Private Sub mRiser_Click()
'''The click event to toggle the desired layer and set the Riser color
    Dim vsoLayer as Visio.Layer
    Set vsoLayer = ActiveDocument.Pages("Filler Boxes, Half Risers and Bass Box Layers").Layers(mRiser.Data1)

    'Toggle the Layer
    vsoLayer.CellsC(visLayerVisible).FormulaU = mRiser.Value
    vsoLayer.CellsC(visLayerPrint).FormulaU = mRiser.Value

    'Color Riser
    If mRiser.Value Then
        mRiser.BackColor = RGB(230, 180, 50)  
    Else
        mRiser.BackColor = RGB(129, 133, 219)
    End If
End Sub

接下来，我们将立管包裹起来并将它们存储在一个集合中。在

ThisDocument

：

Private Risers as Collection         'Collection to hold event-enabled Risers (must go at the top of the module)

Private Sub Document_RunModeEntered(ByVal doc As IVDocument)
'''Initialize drawing
    Dim ctl as OLEObject           'An Object on the drawing, access directly with .Object
    Set Risers = New Collection

    'Loop through the Control objects in the document to find the buttons
    For Each ctl in doc.OLEObjects
        'Filter by TypeName, enabling Click events for all CommandButtons
        If TypeName(ctl.Object) = "ToggleButton" Then Risers.Add NewRiser(ctl.Object)
    Next
End Sub

Private Function NewRiser(ByRef Riser as Object) as RiserWrapper
'''Wraps a given Riser and returns the wrapped object
    Set NewRiser = New RiserWrapper                     'Create wrapper instance
    Set NewRiser.mRiser = Riser                         'Wrap the Riser
End Function

我们就完成了！