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 de Dante Amor
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 Subsal 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
