2

I previously asked a question and received a response from T.M. that answered it perfectly!

However, when I entered the code in a secondary form, I get the same error that I originally received in the main form.

Below is the code that is placed in the form and class module as well as some screen shots to better illustrate the second form as I'm not sure if I explained that very clearly...

Thank you all so much in advance!

Code in the form:

Dim cBar As clsBar

Private Sub UserForm_Initialize()

    On Error GoTo Whoa
    Application.EnableEvents = False

    Set cBar = New clsBar
    cBar.Initialize Me

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue

End Sub

Code in Class Module

'Popup objects
Private cmdBar As CommandBar
Private WithEvents cmdCopyButton As CommandBarButton
Private WithEvents cmdPasteButton As CommandBarButton

'Useform to use
Private fmUserform As Object

'Control array of textbox
Private colControls As Collection

'Textbox Control
Private WithEvents tbControl As MSForms.TextBox

'Adds all the textbox in the userform to use the popup bar
Sub Initialize(ByVal UF As Object)
    Dim Ctl As MSForms.Control
    Dim cBar As clsBar

    For Each Ctl In UF.Controls
        If TypeName(Ctl) = "TextBox" Then

            'Check if we have initialized the control array
            If colControls Is Nothing Then
                Set colControls = New Collection
                Set fmUserform = UF
                'Create the popup
                CreateBar
            End If

            'Create a new instance of this class for each textbox
            Set cBar = New clsBar
            cBar.AssignControl Ctl, cmdBar
            'Add it to the control array
            colControls.Add cBar

        End If
    Next Ctl
End Sub

Private Sub Class_Terminate()
    'Delete the commandbar when the class is destroyed
    On Error Resume Next
    cmdBar.Delete
End Sub

'Click event of the copy button
Private Sub cmdCopyButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    Dim sACN As String
    sACN = ActiveControlName(fmUserform)    ' find control's name
    ' Debug.Print sACN & ".Copy"
    fmUserform.Controls(sACN).copy          ' << instead of fmUserform.ActiveControl.Copy
    CancelDefault = True
End Sub

'Click event of the paste button
Private Sub cmdPasteButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    Dim sACN As String
    sACN = ActiveControlName(fmUserform)
    ' Debug.Print sACN & ".Paste"
    fmUserform.Controls(sACN).Paste    ' << instead of fmUserform.ActiveControl.Paste
    CancelDefault = True
End Sub

'Right click event of each textbox
Private Sub tbControl_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 2 And Shift = 0 Then
        'Display the popup
        cmdBar.ShowPopup
    End If
End Sub

Private Sub CreateBar()
    Set cmdBar = Application.CommandBars.Add(, msoBarPopup, False, True)
    'We’ll use the builtin Copy and Paste controls
    Set cmdCopyButton = cmdBar.Controls.Add(ID:=19)
    Set cmdPasteButton = cmdBar.Controls.Add(ID:=22)
End Sub

'Assigns the Textbox and the CommandBar to this instance of the class
Sub AssignControl(TB As MSForms.TextBox, Bar As CommandBar)
    Set tbControl = TB
    Set cmdBar = Bar
End Sub

Function ActiveControlName(form As UserForm) As String
    'cf Site: https://stackoverflow.com/questions/47745663/get-activecontrol-inside-multipage
    'Purpose: get ActiveControl

    Dim MyMultiPage As MSForms.MultiPage, myPage As MSForms.Page

    If form.ActiveControl Is Nothing Then
        ' do nothing
    ElseIf TypeName(form.ActiveControl) = "MultiPage" Then
        Set MyMultiPage = form.ActiveControl
        Set myPage = MyMultiPage.SelectedItem
        ActiveControlName = myPage.ActiveControl.Name
    Else
        ActiveControlName = form.ActiveControl.Name
    End If
End Function

Form 1

2nd form that the code is not working in

When I click copy or paste within the second form, I get the error:

Run-Time Error '438':
Object doesn't support this property or method.

on the line: fmUserform.Controls(sACN).Paste

Community
  • 1
  • 1
crick1988
  • 53
  • 5
  • Please edit the **code** by which you show both the *original UserForm* and the *2nd* one. As your class module is the same, I suspect the issue to be somewhere in the calling codes. – T.M. Jul 10 '18 at 08:54
  • The code that I have in the 2nd form is the same as the one that I have in the original one (the first code in my post). I thought that it would be as it was calling the same code, just applying it to a different form. – crick1988 Jul 10 '18 at 17:30
  • Sorry for the misunderstanding -I thought it to be possibly helpful to read a) the exact code behind your button "FAT" to launch the 2nd UserForm as well as b) the code to call the main form and c) if you are showing it modeless or modal. – T.M. Jul 11 '18 at 05:32
  • 1
    Oh! sorry, I totally misunderstood. The code in the button is: CAT.Show vbModeless The code in the main form is: YODA.Show vbModeless – crick1988 Jul 11 '18 at 19:23
  • Found a solution for your 2nd userform issue. - Could you give my answer already a try? – T.M. Jul 17 '18 at 18:50
  • I would be interested if my solution to your 2nd userform issue actually solved your problem so that you can mark it as accepted. – T.M. Aug 24 '18 at 14:58

1 Answers1

0

Necessary modifications for 2nd UserForm call

Issues seem to occur showing the 2nd form directly within the 1st one and because the click events get return values from the clicked "CAT" control, too.

This worked for me:

  1. Suggest to show the 2nd UserForm via ShowYODA only in your UF module, i.e. calling a procedure located in a separate module, e.g.

Example call for 2nd form in a separate module

Sub ShowYODA
    With New YODA           ' temporary new UF instance
        .Show vbModeless
    End With
End Sub
  1. Changes are needed in the following event procedures and the called helper function (using a end space marker for textboxes only that will be trimmed in the calling events):

Relevant click events

'Click event of the copy button
Private Sub cmdCopyButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
Dim sACN As String
sACN = ActiveControlName(fmUserform)    ' find control's name
If Right$(sACN, 1) = " " Then           ' marker (=ending space) for textboxes only!
       Debug.Print Trim(sACN) & ".Copy"
   fmUserform.Controls(Trim(sACN)).Copy ' << instead of fmUserform.ActiveControl.Copy /438 unterstü.d.Meth nicht!
   CancelDefault = True
End If
End Sub

'Click event of the paste button
Private Sub cmdPasteButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
Dim sACN As String
sACN = ActiveControlName(fmUserform)    ' find control's name
If Right$(sACN, 1) = " " Then           ' marker (=ending space) for textboxes only!
       Debug.Print Trim(sACN) & ".Copy"
   fmUserform.Controls(Trim(sACN)).Paste    ' << instead of fmUserform.ActiveControl.Copy
   CancelDefault = True
End If
End Sub

Modified helper function ActiveControlName()

Function ActiveControlName(form As MSForms.UserForm) As String
'cf Site: https://stackoverflow.com/questions/47745663/get-activecontrol-inside-multipage
'Purpose: get ActiveControl name string and mark text boxes by an ending space
 Dim MyMultiPage As MSForms.MultiPage, myPage As MSForms.Page
 If form.ActiveControl Is Nothing Then
    ' do nothing
 ElseIf TypeName(form.ActiveControl) = "MultiPage" Then
    Set MyMultiPage = form.ActiveControl
    Set myPage = MyMultiPage.SelectedItem
    ActiveControlName = myPage.ActiveControl.Name
    If TypeName(form.Controls(ActiveControlName)) = "TextBox" Then ActiveControlName = ActiveControlName & " "
 Else
    ActiveControlName = form.ActiveControl.Name
    If TypeName(form.Controls(ActiveControlName)) = "TextBox" Then ActiveControlName = ActiveControlName & " "
 End If
 End Function
T.M.
  • 9,436
  • 3
  • 33
  • 57