2

I'm currently working on a project where I'll be selecting up to 5 items to compare to each other, with the results being displayed in up to a 5x5 dynamic grid. My objective is to have this grid be composed of command buttons such that the caption of each button is the percent similarity between the row and column items, and on clicking the button, the units that are common between the row and column items will be displayed in a message box.

I more or less know how to generate the actual array of buttons. However, everything I've read suggests that I need to create a class to handle the button clicks, since I don't feel like making 20 subroutines that all have the same code in them. I have not been able to get this class to work properly, and I could use some tips. Here's what I have so far.

In a class module named 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

And in the userform itself:

      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

Currently, I get a "Object with or Block variable not set" when I hit the Set ComparisonArray line, and I'm stymied. Am I just missing something in the class module? Thanks in advance for the help.

Edited to add: I tried to model the class code in part off of this article, but again I haven't got it to work yet. http://www.siddharthrout.com/index.php/2018/01/15/vba-control-arrays/

Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250
Andrew
  • 23
  • 1
  • 4

3 Answers3

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

As soon as Userform_Initialize completes, ComparisonArray() will go out of scope and no longer exist: you need to make that a Global variable in your form so it will be around to handle any events.

Tim Williams
  • 154,628
  • 8
  • 97
  • 125
0

Your code seems correct and interesting. The only (bug) I could see is:

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

The problem is that your array holds null references. You have not created your DynButton objects yet. You must explicitly creat the objects in your array.

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

Also, declare the array ComparisonArray as a member object of the form, not as a local variable in Form_Initialize.

A.S.H
  • 29,101
  • 5
  • 23
  • 50
  • Thanks a lot, works just fine now. Followup, since you seem to have a handle on what I'm trying to do: is there a good way to pass the name of the clicked button through to the class module sub, besides Application.Caller? Application.Caller seems to always return the same thing regardless of what button I click, and I think it's because I'm actually calling the VBA code from the same button, while this form occurs a few layers deeper. – Andrew Oct 13 '15 at 17:51
  • You are welcome :). You have access to CBevents.Name property, you have it when you handle the event. I dont quite understand the requirement, what do you want to do with it after that? – A.S.H Oct 13 '15 at 18:01
  • ps: the .Name property might not appear with IntelliSense, but you should have it. – A.S.H Oct 13 '15 at 18:06
  • To be honest I'm still not 100% sure how WithEvents works in general, but let me see if I have this straight: When I click on one of these buttons, it'll trigger the CBevents_click() subroutine. Inside that, I could use CBevents.Name and that would give me the name of what called the click routine? Essentially I just need the i and j values of the button that was clicked. – Andrew Oct 13 '15 at 19:22
  • yes, you get the name this way. When you constructed the button array controls, you have set their names to `Cstr(i) & Cstr(j) & cb`. You can change this into something like `Cstr(i) & "_" & Cstr(j)`. Then when you receive the name, you can split it using `ar = Split(name, "_")`, you get `i = ar(0)` and `j = ar(1)`. Hope this works. – A.S.H Oct 13 '15 at 19:31
0

Only copy paste

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
Paulo Vieira
  • 101
  • 2