Crear una Clase para los textbox que necesito con la primera letra en mayúsculas

Tengo por aquí algo que no recuerdo donde fue que lo baje o quien me lo facilitó

'Pegar TODO lo de abajo en el Modulo de Clase nombre Clase1
Option Explicit
Public WithEvents tbxCustom1 As MSForms.TextBox 'Personalisar nombre a los Textbox
'Referencia
Private Sub tbxCustom1_Change()
    tbxCustom1 = Application.Proper(tbxCustom1)
    'Reemplazar 1ª letra
    tbxCustom1 = VBA.Replace(tbxCustom1, " Al ", " al ")
    tbxCustom1 = VBA.Replace(tbxCustom1, " No ", " no ")
    tbxCustom1 = VBA.Replace(tbxCustom1, " De ", " de ")
    tbxCustom1 = VBA.Replace(tbxCustom1, " La ", " la ")
    tbxCustom1 = VBA.Replace(tbxCustom1, " Se ", " se ")
    tbxCustom1 = VBA.Replace(tbxCustom1, " Si ", " si ")
    tbxCustom1 = VBA.Replace(tbxCustom1, " Los ", " los ")
    tbxCustom1 = VBA.Replace(tbxCustom1, " El ", " el ")
    tbxCustom1 = VBA.Replace(tbxCustom1, " Del ", " del ")
End Sub
Private Sub Class_Terminate()
     'Destruir la clase de objeto y liberar memoria
    Set tbxCustom1 = Nothing
End Sub
Dim colTbxs As Collection 'SOLO PARA colección de cuadros de texto personalizado. 1ª letra en Mayuscula
'Pegar en codigo del formulario
Private Sub UserForm_Initialize()
    Dim ctlLoop As MSForms.Control
    Dim clsObject As Clase1
    'Crear nueva colección de cuadros de texto personalizado
    Set colTbxs = New Collection
    'Bucle a través de controles en Userform
    For Each ctlLoop In Me.Controls
         'Compruebe si el Control es un control Textbox
        If TypeOf ctlLoop Is MSForms.TextBox Then
            Select Case ctlLoop.Name
            'agregar los textbox que sí entran en Tipo Título con el nombre que tienen en el Form
            Case "TextBox1", "TextBox3" 'Aqui colocar el nombre que tienen en el form
                 'Crear una nueva instancia de la clase del controlador de eventos
                Set clsObject = New Clase1
                 'Establecer la nueva instancia para controlar los eventos de nuestro cuadro de texto
                Set clsObject.tbxCustom1 = ctlLoop
                 'Agregar el controlador de eventos a nuestra colección
                colTbxs.Add clsObject
            End Select
        End If
    Next ctlLoop
End Sub
''''''''''''''''''''''''''''''''''''
Private Sub UserForm_Terminate()
'Destruir la clase de objeto y liberar memoria
    Set colTbxs = Nothing 'SOLO PARA TextBox's personalisados
End Sub

Funciona de lo mejor pero, veo que se torna mas largo que hacerlo individual a cada TextBox, son 5 TextBox.

Bueno si porque te dá la opcion de agregar los textBox que quieres porque tengo un otro que es para TODOS los del formulario.

Este tambien da para Todos si le quitas el Case ,,,,,,,,,,,,,, Select case

Dime si te parece bien o se puede hacer mas corto todo el codigo

¿Qué te parece?

1 respuesta

Respuesta
1

H o l a:

Esto lo tienes que poner en la Clase1

Option Explicit
Public WithEvents tbxCustom1 As MSForms.TextBox 'Custom Textbox
'Referencia
'http://www.ozgrid.com/forum/showthread.php?t=80631
Private Sub tbxCustom1_Change()
'Por.Dante Amor
    tbxCustom1 = Application.Proper(tbxCustom1)
End Sub
'
Private Sub Class_Terminate()
     'Destroy The Class Object And Free Up Memory
    Set tbxCustom1 = Nothing
End Sub

Y esto lo tienes que poner en tu formulario:

Const GWL_STYLE = -16
Const WS_CAPTION = &HC00000
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Dim colTbxs As Collection
Private Sub UserForm_Initialize()
    '
    Dim celda
    Dim lngWindow As Long, lFrmHdl As Long
    frmLista.Height = 116
    frmLista.Width = 579.75
    lFrmHdl = FindWindowA(vbNullString, Me.Caption)
    lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
    lngWindow = lngWindow And (Not WS_CAPTION)
    Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
    Call DrawMenuBar(lFrmHdl)
    '
    ComboBox1.Enabled = False
    Me.ComboBox1.Clear
    For Each celda In Range("D11:d" & Range("B" & Rows.Count).End(xlUp).Row)
        If celda <> Empty Then ComboBox1.AddItem celda.Value
    Next
    'Cargar textbox
    Dim ctlLoop As MSForms.Control
    Dim clsObject As Clase1
    'Create New Collection To Store Custom Textboxes
    Set colTbxs = New Collection
    'Loop Through Controls On Userform
    For Each ctlLoop In Me.Controls
        'Check If Control Is A Textbox
        Select Case ctlLoop.Name
            Case "TextBox3", "TextBox7", "TextBox8", "TextBox10", "TextBox11"
                minom = ctlLoop.Name
                If TypeOf ctlLoop Is MSForms.TextBox Then
                     'Create A New Instance Of The Event Handler CLass
                    Set clsObject = New Clase1
                     'Set The New Instance To Handle The Events Of Our Textbox
                    Set clsObject.tbxCustom1 = ctlLoop
                     'Add The Event Handler To Our Collection
                    colTbxs.Add clsObject
                End If
        End Select
    Next ctlLoop
    'Fin cargar textbox
    '
End Sub

sal u dos

Si quieres que funcione para todos los textbox:

    For Each ctlLoop In Me.Controls
        'Check If Control Is A Textbox
        If TypeOf ctlLoop Is MSForms.TextBox Then
             'Create A New Instance Of The Event Handler CLass
            Set clsObject = New Clase1
             'Set The New Instance To Handle The Events Of Our Textbox
            Set clsObject.tbxCustom1 = ctlLoop
             'Add The Event Handler To Our Collection
            colTbxs.Add clsObject
        End If
    Next ctlLoop

O si prefieres que NO funcione para algunos, por ejemplo, para la cantidad y para la fecha:

    For Each ctlLoop In Me.Controls
        'Check If Control Is A Textbox
        Select Case ctlLoop.Name
            Case "TextBox4", "TextBox6"
            Case Else
                If TypeOf ctlLoop Is MSForms.TextBox Then
                     'Create A New Instance Of The Event Handler CLass
                    Set clsObject = New Clase1
                     'Set The New Instance To Handle The Events Of Our Textbox
                    Set clsObject.tbxCustom1 = ctlLoop
                     'Add The Event Handler To Our Collection
                    colTbxs.Add clsObject
                End If
        End Select
    Next ctlLoop

sal u dos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas