2

我目前正在开展一个项目，我将选择最多 5 个项目进行比较，结果显示在最多 5x5 的动态网格中。我的目标是让这个网格由命令按钮组成，这样每个按钮的标题是行和列项目之间的百分比相似度，并且在单击按钮时，将显示行和列项目之间的共同单位在一个消息框中。

我或多或少知道如何生成实际的按钮数组。但是，我读到的所有内容都表明我需要创建一个类来处理按钮单击，因为我不想制作 20 个子程序，它们都具有相同的代码。我无法让这个类正常工作，我可以使用一些技巧。这是我到目前为止所拥有的。

在名为 DynButton 的类模块中：

Public Withevents CBevents as MSForms.CommandButton
Private Sub CBevents_Click()
    DisplayOverlappedUnits 'Sub that will display the units that are the same
                           'between items i and j- may use Application.Caller
End Sub

在用户表单本身中：

      Private Sub Userform_Initialize()
        Dim NumItems as integer
        Dim ComparisonArray() as DynButton
        Dim ctlButton as MSForms.CommandButton
        'QuestionList() is a public type that stores various attributes of the 
        'items I'm comparing.

       'This code determines how many items were selected for comparison
       'and resets the item array accordingly.
       NumItems=0
       For i=1 to 5 
           If QuestionList(i).Length>0 Then
              NumItems=Numitems+1
              QuestionList(NumItems)=QuestionList(i)
           End If
       Next

Redim ComparisonArray(1 to NumItems, 1 to NumItems)
For i = 1 to NumItems
    For j=1 to NumItems
        Set ctlButton=Me.Controls.Add("Forms.CommandButton.1", Cstr(i) & Cstr(j) & cb)
        With ctlButton
            .Height= CB_HEIGHT 'These are public constants defined elsewhere.
            .Width= CB_WIDTH
            .Top= TOP_OFFSET + (i * (CB_HEIGHT+ V_PADDING))
            If i = j Then .visible = False
            .Caption= CalculateOverlap(i,j) 'Runs a sub that calculates the overlap between items i and j
            End With
        Set ComparisonArray(i,j).CBevents = ctlButton
        Next
    Next
End Sub

目前，当我点击 Set ComparisonArray 行时，我得到一个“未设置对象或块变量”，我被困住了。我只是在类模块中遗漏了一些东西吗？在此先感谢您的帮助。

编辑添加：我尝试在本文的部分内容中对类代码进行建模，但我还没有让它工作。http://www.siddharthout.com/index.php/2018/01/15/vba-control-arrays/

4

3 回答 3

1 
Private Sub Userform_Initialize()
        Dim NumItems as integer
        Dim ComparisonArray() as DynButton  '<<<< should be a Global variable

一旦Userform_Initialize完成，ComparisonArray()将超出范围并且不再存在：您需要在表单中将其设为全局变量，以便处理任何事件。

于 2015-10-12T21:42:20.170 回答
0

您的代码似乎正确且有趣。我能看到的唯一（错误）是：

Redim ComparisonArray(1 to NumItems, 1 to NumItems)
...
Set ComparisonArray(i,j).CBevents = ctlButton

问题是您的数组包含空引用。您尚未创建DynButton对象。您必须在数组中显式创建对象。

Redim ComparisonArray(1 to NumItems, 1 to NumItems)
For i = 1 to NumItems
    For j = 1 to NumItems
       Set ComparisonArray(i,j) = new DynButton
    Next
Next        
...
Set ComparisonArray(i,j).CBevents = ctlButton

此外，将数组 ComparisonArray 声明为表单的成员对象，而不是 Form_Initialize 中的局部变量。

于 2015-10-12T20:49:38.780 回答
0

只能复制粘贴

Option Private Module
Option Explicit

Private Const i_total_channels As Integer = 100

Sub createArrayOfbuttons()
    Application.ScreenUpdating = False
    f_create_buttons 5, 5, 30, 5, True
End Sub

Sub clearArrayOfButtos()
    Application.ScreenUpdating = False
    f_clear_array_of_buttons
End Sub

Private Function f_create_buttons(Optional posLeft As Integer = 0, Optional posTop As Integer = 0, _
    Optional sizeSquare As Integer = 20, Optional distBetween As Integer, Optional buttonColor As Boolean = False)
'create customized buttons to channel choice.
    Dim i_ch_amount_x As Integer
    Dim i_ch_amount_y As Integer
    Dim i_size_X 'size of square button
    Dim i_size_Y 'size of square button
    Dim i_stp_X As Integer 'step in X
    Dim i_stp_Y As Integer 'step in Y
    Dim i_dist_bte_buttons As Integer 'distance between buttons, in X and Y
    Dim i_pos_ini_X As Integer 'initial position
    Dim i_pos_ini_Y As Integer
    Dim it_x As Integer 'iterator
    Dim it_y As Integer 'iterator
    Dim amount As Integer 'channel acumulator
    Dim FO_color As Integer 'index from 1 to 12 to change background color of button

    f_clear_array_of_buttons

    i_pos_ini_X = posLeft
    i_pos_ini_Y = posTop

    'create dimensions of square
    i_size_X = sizeSquare
    i_size_Y = i_size_X 'to create a square Y need same size of X

    'distance between squares
    i_dist_bte_buttons = i_size_X + distBetween 'to shift distance change laste value of expression
    i_stp_X = i_pos_ini_X

    i_stp_Y = i_pos_ini_Y


    i_ch_amount_x = Int(Sqr(i_total_channels)) 'total channels in switch (i_ch_amount_y * i_ch_amount_x)
    i_ch_amount_y = i_ch_amount_x

    amount = 1
    FO_color = 1
    For it_y = 1 To i_ch_amount_x
        For it_x = 1 To i_ch_amount_y
            f_create_button amount, i_stp_X, i_stp_Y, CSng(i_size_X), CSng(i_size_Y), FO_color
            i_stp_X = i_stp_X + i_dist_bte_buttons
            amount = amount + 1
            If buttonColor Then
                FO_color = FO_color + 1
            End If
            If FO_color > 12 Then 'return FO to 1
                FO_color = 1
            End If
        Next it_x
        i_stp_X = i_pos_ini_X
        i_stp_Y = i_stp_Y + i_dist_bte_buttons
    Next it_y

    amount = 0
    i_ch_amount_x = 0
    i_ch_amount_y = 0
    i_size_X = 0
    i_size_Y = 0
    i_stp_X = 0
    i_stp_Y = 0
    i_pos_ini_X = 0
    i_pos_ini_Y = 0
    i_dist_bte_buttons = 0
    FO_color = 0
End Function

Private Function f_create_button(index As Integer, posLeft As Integer, posRight As Integer, _
    Box_width As Single, Box_height As Single, Optional FO As Integer)
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, posLeft, posRight, Box_width, Box_height). _
        Select
    With Selection
        .Name = "ch_" & index
        .Text = index
        .Font.Name = "Arial"
        .Font.Bold = True
        If FO = 9 Then
            .Font.Color = vbWhite
        Else
            .Font.ColorIndex = xlAutomatic
        End If
        .Font.Size = 10
        .Interior.Color = fiber_color(FO)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
End Function

Public Function fiber_color(Optional FO As Integer = 1) As Long
'use with a index in FO from 1 to 12
    Select Case FO
    Case 1
        fiber_color = 65280 'green
    Case 2
        fiber_color = 65535 'yellow
    Case 3
        fiber_color = 16777215 'white
    Case 4
        fiber_color = 16711680 'blue
    Case 5
        fiber_color = 255 'red
    Case 6
        fiber_color = 16711823 'violt
    Case 7
        fiber_color = 19350 'brown
    Case 8
        fiber_color = 13353215 'pink
    Case 9
        fiber_color = 0 'black
    Case 10
        fiber_color = 16711680 'cinza
    Case 11
        fiber_color = 32767 'orange
    Case 12
        fiber_color = 16776960 'aqua
    Case Else
        fiber_color = 65280 'verde
    End Select
End Function

Private Function f_clear_array_of_buttons()
    Dim i_ch_amount_x As Integer
    Dim it As Integer

    i_ch_amount_x = i_total_channels
    On Error GoTo sair
    If ActiveSheet.Shapes.Count <> 0 Then
        For it = 1 To i_ch_amount_x
            ActiveSheet.Shapes("ch_" & it).Delete
        Next it
    End If
sair:
    i_ch_amount_x = 0
    it = 0
End Function
于 2019-03-27T03:05:52.137 回答