Add an image to userForm with click event using vba

Question

I created a userForm to make possible to create a survey. It looks like that at the beginning:

enter image description here

Clicking the cross that is next to "Add answer" you can add more rows as it can be seen in this other image:

enter image description here

The problem that I have is that I have to add those small arrows that are next to the checkboxes in the new rows. Those are to move the answers up and down if the user need to change the position of them. So I have to add code to it to move them.

The creation of the elements that I need in each row is done in the following way:

Private Sub addAnswer_Click()
Image5.top = Image5.top + 21
CheckBox1.top = CheckBox1.top + 21
CheckBox2.top = CheckBox2.top + 21
Image7.height = Image7.height + 21
Image3.top = Image3.top + 21
Label1.top = Label1.top + 21
Label4.top = Label4.top + 21
Image2.top = Image2.top + 21
tablet.top = tablet.top + 21
chart.top = chart.top + 21
Label8.top = Label8.top + 21
Label9.top = Label9.top + 21
LabelOrizontal.top = LabelOrizontal.top + 21
LabelVertical.top = LabelVertical.top + 21
LabelNet.top = LabelNet.top + 21
LabelRound.top = LabelRound.top + 21
LabelPoints.top = LabelPoints.top + 21
Orizontal.top = Orizontal.top + 21
Vertical.top = Vertical.top + 21
Net.top = Net.top + 21
Points.top = Points.top + 21
Round.top = Round.top + 21
ExcelBox.top = ExcelBox.top + 21

OKButton.top = OKButton.top + 21
CancelButton.top = CancelButton.top + 21
'Me.MultiPage1.height = Me.MultiPage1.height + 21
Image1.height = Image1.height + 21

'height = 418 + 21 * (valueNum - 1)
If valueNum = 2 Then
    With Me
        'This will create a vertical scrollbar
        .MultiPage1.Pages(0).ScrollBars = fmScrollBarsVertical

        'Change the values of 2 as Per your requirements
        '.ScrollHeight = .InsideHeight
        '.ScrollWidth = .InsideWidth * 9
    End With
End If
Me.MultiPage1.Pages(0).ScrollHeight = Me.MultiPage1.Pages(0).InsideHeight + 21 * (valueNum - 1)
valueNum = valueNum + 1
Set cCntrl = Me.MultiPage1.Pages(0).Controls.Add("Forms.TextBox.1", "textBox" & valueNum, True)
    With cCntrl
        .width = 156
        .height = 18
        .top = 108 + (valueNum - 1) * 21
        .left = 48
        .TabIndex = tabInd
        .ZOrder (0)
    End With
Set cCntrl1 = Me.MultiPage1.Pages(0).Controls.Add("Forms.TextBox.1", "AnsLabBox" & valueNum, True)
    With cCntrl1
        .width = 144
        .height = 18
        .top = 108 + (valueNum - 1) * 21
        .left = 210
        .TabIndex = tabInd + 1
        .ZOrder (0)
    End With

tabInd = tabInd + 3
Set cCntrl3 = Me.MultiPage1.Pages(0).Controls.Add("Forms.CheckBox.1", "open" & valueNum, True)
    With cCntrl3
        .left = 24
        .width = 11
        .height = 18
        .BackColor = "&H8000000E"
        .top = 108 + (valueNum - 1) * 21
        .ZOrder (0)
    End With


'''''''Here starts the important part for the question!!!
Set cCntrl3 = Me.MultiPage1.Pages(0).Controls.Add("Forms.Image.1", "down" & valueNum - 1, True)
    With cCntrl3
        .left = 12
        .width = 12
        .height = 6
        .BackColor = "&H8000000E"
        .top = 116 + (valueNum - 2) * 21
        .Picture = LoadPicture(addInPath & "\fixContent\triangleDown.jpg")
        .BorderStyle = fmBorderStyleNone
        .PictureSizeMode = fmPictureSizeModeStretch
        .ZOrder (0)
    End With
With ActivePresentation.VBProject.VBComponents("surveyCreation").CodeModule
    X = .CountOfLines
    .InsertLines X + 1, "Private Sub down" & valueNum - 1 & "_Click()"
    .InsertLines X + 2, "goDown " & valueNum - 1
    .InsertLines X + 3, "End Sub"
End With
Set cCntrl3 = Me.MultiPage1.Pages(0).Controls.Add("Forms.Image.1", "up" & valueNum, True)
    With cCntrl3
        .left = 12
        .width = 12
        .height = 6
        .BackColor = "&H8000000E"
        .top = 111 + (valueNum - 1) * 21
        .Picture = LoadPicture(addInPath & "\fixContent\triangleUp.jpg")
        .BorderStyle = fmBorderStyleNone
        .PictureSizeMode = fmPictureSizeModeStretch
        .ZOrder (0)
    End With
With ActivePresentation.VBProject.VBComponents("surveyCreation").CodeModule
    X = .CountOfLines
    .InsertLines X + 1, "Private Sub up" & valueNum & "_Click()"
    .InsertLines X + 2, "goUp " & valueNum
    .InsertLines X + 3, "End Sub"
End With
Set cCntrl3 = Me.MultiPage1.Pages(0).Controls.Add("Forms.Image.1", "delete" & valueNum, True)
    With cCntrl3
        .left = 480
        .width = 12
        .height = 12
        .BackColor = "&H8000000E"
        .top = 110 + (valueNum - 1) * 21
        .Picture = LoadPicture(addInPath & "\fixContent\cross.jpg")
        .BorderStyle = fmBorderStyleNone
        .PictureSizeMode = fmPictureSizeModeStretch
        .ZOrder (0)
    End With
With ActivePresentation.VBProject.VBComponents("surveyCreation").CodeModule
    X = .CountOfLines
    .InsertLines X + 1, "Private Sub delete" & valueNum & "_Click()"
    .InsertLines X + 2, "deleteRow " & valueNum
    .InsertLines X + 3, "End Sub"
End With
If Not comboVisi Then
    cCntrl2.Visible = False
End If
End Sub

So as you can see I create the elements and I also add some code (Click events) to the surveyCreation (witch is the userForm)

The deleteRow, goUp and goDown methods are also defined. But it is never entering in the click events. The first click events (the ones that are made for the arrows that appears in the first image) are defined previously and they are working but not the ones that I define using the code that I created. So can I make them work?

You need to create objects to subscribe to the events of the controls you are adding — SWa, Jun 10 '14 at 16:10
What kind of object? and how can I set it up? If you put and example would be really appreciated thanks — Iban Arriola, Jun 10 '14 at 17:08
Have a look here http://stackoverflow.com/questions/10592641/assign-event-handlers-to-controls-on-user-form-created-dynamically-in-vba/10596866#10596866 — SWa, Jun 10 '14 at 18:39
Thanks for the link. I check the example but is a bit different of what I want to make... There there is a code written already in the class that you execute pressing the button. What I want to do is to create a code that can be executed in the moment of creation. And the code is in the userForm itself not in the class. — Iban Arriola, Jun 11 '14 at 08:42
I really don't see how you want to make it with the example that you gave me because the thing is that you can create as much new rows as you want so there can be 50 new rows. With the example that you showed to me I don't know how I do to use this class for all the new rows I created because I change a bit the code for each row to know in what line I am. So for example in the 3rd line I will have to put goUp 3 and in the 30th line I will use goUp 30. So I always call to the same method but I have to change the line value otherwise the goUp method doesn't know where to make the proper changes. — Iban Arriola, Jun 11 '14 at 09:20
Your architecture/design is wrong - you can simply pass the row number into he class, or create a custom wrapper to handle the collection of rows for yuo — SWa, Jun 11 '14 at 09:28
So I have to create a new instance of the class every time I create a new row and put there the number of the row? I am not really sure how I have to do that... — Iban Arriola, Jun 11 '14 at 09:40
I keep trying and finally it is working! Thanks for the tip and the patience! — Iban Arriola, Jun 11 '14 at 10:17

score 0 · Accepted Answer · answered Jun 11 '14 at 11:35

As a follow up to the comments, here's a working example of the sort of thing that you are trying to do:

Class Answer

Option Explicit

Public Key As String
Public Answer As String
Public AnswerLabel As String

Class Answer Controls

Option Explicit

Public WithEvents Answer As MSForms.TextBox
Public WithEvents AnswerLabel As MSForms.TextBox
Private WithEvents Remove As MSForms.CommandButton
Private WithEvents MoveUp As MSForms.Label
Private WithEvents MoveDown As MSForms.Label

Private p_Parent As Object
Private p_rowKey As String
Private p_Answers As Answers
Private p_data As Answer

Const padding = 5
Const tbWidth = 100


Public Sub AddRow(top As Double, left As Double, parent As Answers, container As Object, RowKey As String)

    Set p_Parent = container
    Set p_Answers = parent
    p_rowKey = RowKey

    Set Answer = p_Parent.Controls.Add("forms.textbox.1", "tb1" + RowKey)
    Set AnswerLabel = p_Parent.Controls.Add("forms.textbox.1", "tb2" + RowKey)
    Set Remove = p_Parent.Controls.Add("forms.commandbutton.1", "cb" + RowKey)
    Set MoveUp = p_Parent.Controls.Add("forms.Label.1", "lb1" + RowKey)
    Set MoveDown = p_Parent.Controls.Add("forms.Label.1", "lb2" + RowKey)

    With MoveUp
        .left = left
        .top = top
        .Caption = "up"
        .Width = 35
    End With

    With MoveDown
        .left = left + 20 + padding
        .top = top
        .Caption = "Down"
        .Width = 35
    End With

    With Answer
        .left = left + (35 * 2) + (padding * 2)
        .top = top
        .Width = tbWidth
    End With

    With AnswerLabel
        .left = left + (50 * 2) + (padding * 2) + padding + tbWidth
        .top = top
        .Width = tbWidth
    End With

    With Remove
        .left = left + (50 * 2) + (padding * 2) + padding + (tbWidth * 2) + padding
        .top = top
        .Height = AnswerLabel.Height
        .Caption = "X"
    End With

End Sub

Private Sub Answer_Change()
    p_data.Answer = Answer.Text
End Sub

Private Sub AnswerLabel_Change()
    p_data.AnswerLabel = AnswerLabel.Text
End Sub

Private Sub Class_Terminate()

    p_Parent.Controls.Remove Answer.Name
    p_Parent.Controls.Remove AnswerLabel.Name
    p_Parent.Controls.Remove MoveUp.Name
    p_Parent.Controls.Remove MoveDown.Name
    p_Parent.Controls.Remove Remove.Name

End Sub

Private Sub MoveDown_Click()
    p_Answers.MoveDown p_data.Key
End Sub

Private Sub MoveUp_Click()
    p_Answers.MoveUp p_data.Key
End Sub

Private Sub Remove_Click()
    p_Answers.Remove p_data.Key, p_rowKey
End Sub
Public Property Set data(data As Answer)
    Set p_data = data
    Answer.Value = data.Answer
    AnswerLabel.Value = data.AnswerLabel
End Property

Class Answers

Option Explicit

Private answerList As Collection
Private rowList As Collection
Private no_rows As Long
Public parent As Object

Public Sub MoveUp(Key As String)

    Dim ans As Answer
    Dim x As Long: x = 1

    Set ans = answerList(Key)

    For Each ans In answerList
        If ans.Key = Key Then Exit For
        x = x + 1
    Next ans

    answerList.Remove Key

    If x = 1 Then x = 2 'The item may already be at the top
    answerList.Add ans, ans.Key, x - 1

    Rebind

End Sub
Public Sub MoveDown(Key As String)

    Dim ans As Answer
    Dim x As Long: x = 1

    Set ans = answerList(Key)

    For Each ans In answerList
        If ans.Key = Key Then Exit For
        x = x + 1
    Next ans

    answerList.Remove Key


    If x >= answerList.Count Then
        answerList.Add ans, ans.Key
    Else
        answerList.Add ans, ans.Key, x + 1
    End If

    Rebind
End Sub
Public Sub MoveToTop(Key As String)

    Dim ans As Answer
    Set ans = answerList(Key)

    answerList.Remove Key
    answerList.Add ans, ans.Key, 1
'Rebind our data to our interface
    Rebind

End Sub
Public Sub Remove(Key As String, RowKey As String)

    Dim ans As Answer
    Dim x As Long: x = 1

    answerList.Remove Key

    Rebind

    rowList.Remove rowList.Count
    no_rows = no_rows - 1
End Sub
Public Sub Add(newAnswer As Answer)
    AddRow
    answerList.Add newAnswer, newAnswer.Key
    Set rowList(rowList.Count).data = newAnswer
End Sub
Private Sub AddRow()

    Dim rowControls As AnswerControls
    Set rowControls = New AnswerControls

    rowControls.AddRow 20 * no_rows, 1, Me, parent, "r" & no_rows
    rowList.Add rowControls, "r" & no_rows

    no_rows = no_rows + 1

End Sub
Private Sub Class_Initialize()
    Set answerList = New Collection
    Set rowList = New Collection
    no_rows = 1
End Sub

Private Sub Rebind()

    Dim ans As Answer
    Dim x As Long
    x = 1
    For Each ans In answerList
        Set rowList(x).data = ans
        x = x + 1
    Next ans

End Sub

Simple implementation in a userform:

Option Explicit

Dim d As Answers
Private Sub UserForm_Click()
    Dim a As New Answer
    a.Key = Rnd * 10
    d.Add a
End Sub
Private Sub UserForm_Initialize()
    Set d = New Answers
    Set d.parent = Me
End Sub

Add an image to userForm with click event using vba

1 Answers1