Solved Pass a code to the detail and header of the form through a class module (1 Viewer)

[zelarra821]

Hello. I have taken a liking to the class modules. I have created another one that works perfectly for me. But there is a detail that I don't know how to do it. I want to pass some code to the detail and header of the form, but I don't know how to do it.

I guess I'll have to declare, at the beginning of the module, something similar to this:

Private WithEvents mCombo As Access.TextBox

But I can't find what I have to declare. Then I'll have to add an argument to the procedure that starts the class module, but I also don't know how to put it or how to pass the argument value to it.

Public Sub InitalizeMouseWheel(FName As Form, Optional TheTextBox As Access.TextBox, Optional MWheel As Boolean = True, _
             Optional SCursor As Boolean)

     SetForm = FName
     Set mCombo = TheTextBox

Could someone help me with these doubts?

Thanks a lot.

 

[arnelgp]

not related to what you need but you should name your variables properly.

mCombo, you should rename this to mTextbox as this is the instance of the Textbox.

also FName is the Form where the TheTextbox textbox is located?
if so, you can delete it from the Sub declaration and instead use

Set mForm = TheTextbox.Parent

 

[zelarra821]

The variables are already corrected, and I have also removed FName. Thank you very much for the contributions.

Do you know anything about what I asked? Or, if not, I wait to see if someone can help me.

Also, I have another problem, and that is that if I start the same class module from the form two or more times, only the last one is executed, and I don't know why that happens.

 

[MajP]

private mHeader as access.section
private mFooter as access.section
Public Sub InitalizeMouseWheel(FName As Form, Optional TheTextBox As Access.TextBox, Optional MWheel As Boolean = True, _
             Optional SCursor As Boolean)
     SetForm = FName
     Set mTextBox = TheTextBox
    set mHeader = GetHeader(fname)
   set mFooter = GetFooter(fname)
end sub

Public Function GetHeader(frm As Access.Form) As Access.Section
  On Error GoTo HasHeader_Error
      Set GetHeader = frm.Section(acHeader)
Exit Function

HasHeader_Error:
HasHeader = False 'Error 2462

End Function
Public Function GetFooter(frm As Access.Form) As Access.Section
  On Error GoTo HasFooter_Error
    Set GetFooter = frm.Section(acFooter)
Exit Function

HasFooter_Error:
HasFooter = False 'Error 2462

End Function

If there is no header or footer the function returns nothing
So you still have to check before calling code

if not mHeader is nothing then

also FName is the Form where the TheTextbox textbox is located?
if so, you can delete it from the Sub declaration and instead use
Set mForm = TheTextbox.Parent

Unfortunately that is not always true. If the Textbox is located on a Tab control the tab control page is the Parent.

 

[zelarra821]

Also, I have another problem, and that is that if I start the same class module from the form two or more times, only the last one is executed, and I don't know why that happens.

And also I have this problem. What can I do to solve it?

 

[MajP]

Also, I have another problem, and that is that if I start the same class module from the form two or more times, only the last one is executed, and I don't know why that happen

Can you post an example. That sounds like expected behaviour. What are you trying to do? You may need a custom collection. If you need to create multiple objects then you have to hold them in a collection. I like to create custom collections to do this

Advanced Class Concepts

Advanced Class Concepts I have posted several threads on using custom classes to extend the capabilities of controls and make pseudo "user controls". https://www.access-programmers.co.uk/forums/threads/developing-custom-classes-to-simulate-user-controls.309080/ This thread has additional concepts.

www.access-programmers.co.uk

 

[zelarra821]

This is the code:

Option Compare Database
Option Explicit

Private WithEvents Form As Access.Form
Private WithEvents mText As Access.TextBox
Private mMoverRueda As Boolean
Private mSituarCursor As Boolean
Private Const acRichtext = 1

Public Property Get MoverRueda() As Boolean
    MoverRueda = mMoverRueda
End Property

Public Property Let MoverRueda(ByVal vNewValue As Boolean)
    mMoverRueda = vNewValue
End Property

Public Property Get SituarCursor() As Boolean
    SituarCursor = mSituarCursor
End Property

Public Property Let SituarCursor(ByVal vNewValue As Boolean)
    mSituarCursor = vNewValue
End Property

Public Property Get FilterTexBox() As Access.TextBox
  Set FilterTexBox = mText
End Property

Public Property Set FilterTextBox(TheTextBox As Access.TextBox)
  Set mText = TheTextBox
End Property

Public Sub InitalizeMouseWheel(Optional TheTextBox As Access.TextBox, Optional MRueda As Boolean = True, _
            Optional SCursor As Boolean)
   On Error GoTo errLabel
    Set Form = TheTextBox.Parent
    Set mText = TheTextBox
    Me.MoverRueda = MRueda
    Me.SituarCursor = SCursor
    mText.OnClick = "[Event Procedure]"
    mText.OnEnter = "[Event Procedure]"
    mText.OnExit = "[Event Procedure]"
    Form.MouseWheel = "[Event Procedure]"
    Exit Sub
error_exit:
    Exit Sub
errLabel:
    MsgBox "InitalizeMouseWheel" & Err.Number & " " & Err.Description, vbInformation, NombreBD
End Sub

Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
    If Me.MoverRueda = True Then
        If Form.ScrollBars = 0 Then
            Dim i As Long
            If Form.ActiveControl.controlType = acTextBox Then
                For i = 1 To Abs(Count)
                    SendMessage GetFocus, WM_VSCROLL, IIf(Count < 0, SB_LINEUP, SB_LINEDOWN), 0&
                Next
            End If
        End If
    End If
End Sub

Private Sub mText_Click()
   If Me.MoverRueda Then
      If Form.ActiveControl.controlType = acTextBox Then
        Form.ScrollBars = 0
        Dim txt As TextBox
        Set txt = Form.ActiveControl
        If txt.TextFormat = acRichtext Then
          Form.RibbonName = "RichText"
        End If
      End If
   End If
End Sub

Private Sub mText_Enter()
   If Me.MoverRueda Then
      If Form.ActiveControl.controlType = acTextBox Then
        Form.ScrollBars = 0
        Dim txt As TextBox
        Set txt = Form.ActiveControl
        If txt.TextFormat = acRichtext Then
          Form.RibbonName = "RichText"
        End If
      End If
   End If
   If Me.SituarCursor = True Then
        SituarCursorTextBox
   End If
End Sub

Private Sub mText_Exit(Cancel As Integer)
   If Me.MoverRueda Then
      If Form.ActiveControl.controlType = acTextBox Then
        Form.ScrollBars = 2
        Dim txt As TextBox
        Set txt = Form.ActiveControl
        If txt.TextFormat = acRichtext Then
          Form.RibbonName = "Database"
        End If
      End If
   End If
End Sub

Private Sub SituarCursorTextBox()
Dim txt As TextBox
Set txt = Form.ActiveControl
    If IsNull(txt) Then
        txt.SelStart = 1
    Else
        txt.SelStart = Len(txt) + 1
    End If
End Sub

Private Sub Class_Terminate()
    Set Form = Nothing
    Set mText = Nothing
End Sub

This kind of module would start it for each of the fields that I want to activate mouse wheel scrolling in a continuous form, and that's why I have added three in the form, but only the last one works for me.

 

[MajP]

 Set Form = TheTextBox.Parent

As I said that line will always fail if the control is located on a tab control. Save the below code to use in other class modules.

Set Form = GetParentForm(TheTextBox)

Public Function GetParentForm(ctrl As Access.Control) As Access.Form
 
  On Error GoTo GetParentForm_Error
  Dim prnt As Object
  Set prnt = ctrl

  Do
    Set prnt = prnt.Parent
    Debug.Print TypeName(prnt)
  Loop Until TypeOf prnt Is Form
  Set GetParentForm = prnt
   
    On Error GoTo 0
    Exit Function
GetParentForm_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetParentForm, line " & Erl & "."
End Function

Can you show the code where you are instantiating he class and the problem is: (Not the class module code, but where you call it in the form)

if I start the same class module from the form two or more times, only the last one is executed, and I don't know why that happens.

Sounds like you want to have multiple instances, so you need a variable for each instance. If you have a lot you may want the custom class.
If you have three instances, you need three variables.

 

[zelarra821]

Sounds like you want to have multiple instances, so you need a variable for each instance. If you have a lot you may want the custom class.
If you have three instances, you need three variables

And how do I do that? I'm reading custom connections and I don't know if it is what I need

 

[MajP]

I want to activate mouse wheel scrolling in a continuous form, and that's why I have added three in the form, but only the last one works for me.

can you show the code where you instantiate the three in the form.

 

[zelarra821]

Dim RuedaRaton As New MouseWheel

Private Sub Form_Load()
    RuedaRaton.InitalizeMouseWheel Me.Titulo1, True
    RuedaRaton.InitalizeMouseWheel Me.Autor, True
    RuedaRaton.InitalizeMouseWheel Me.PorQueAñadoEsteLibro, True, True
End Sub

 

[zelarra821]

You do the same when you use get filter from combobox, and you don't have any collection. I have read the code several times and there is nothing similar a collection.

 

[arnelgp]

you need to have a Callback class so that each "textbox" retains its functionality.
see my demo class about "label controls and attached lines".

 

[zelarra821]

you need to have a Callback class so that each "textbox" retains its functionality.
see my demo class about "label controls and attached lines".

Where can I see that?

 

[MajP]

You do the same when you use get filter from combobox

Yes I do an I have an instance for each combobox. Three instances, Three variables

Dim RuedaRatonTitle As New MouseWheel
Dim RuedaRatonAuthor As New MouseWheel
Dim RuedaRatonLibro As New MouseWheel

Private Sub Form_Load()
    RuedaRatonTitle.InitalizeMouseWheel Me.Titulo1, True
    RuedaRatonAuthor.InitalizeMouseWheel Me.Autor, True
    RuedaRatonLibro.InitalizeMouseWheel Me.PorQueAñadoEsteLibro, True, True
End Sub

 

[zelarra821]

You're right

 

[MajP]

From your old database here is an example where you do this for each combo.

Dim cmbEstado As New FindAsYouTypeCombo
Dim cmbCategoria As New FindAsYouTypeCombo
Dim cmbSubcategoria As New FindAsYouTypeCombo

 

[zelarra821]

Yes, I know. I was looking for something different all the morning and don't see that.

 

[MajP]

For this example it might be overkill, but you should read the post on building a custiom collection. Imagine instead of Three you wanted to do this for 25 controls.

You then could build a custom collection class
MouseWheels

then in code
Dim myMouseWheels As New MouseWheels

Now tag each control with "MW"

In the forms load

Dim ctrl as access.control
for each ctrl in me.controls
  if ctrl.tag = MW
    MouseWheels.add(Ctrl)
 end if
next ctrl

Now you have a single Mousewheel instead of 25 seperate variables.

 

[zelarra821]

Ok, thanks a lot. I have read the article and if I need it, I will do it on that way