'-------------------------------------------------
'Código para un módulo estándar
'-------------------------------------------------
Option Explicit
Option Private Module
'//By JuanC - Oct. 2007
Private Declare Function apiSetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function apiGetFocus Lib "user32" Alias "GetFocus" () As Long
Private Declare Function apiSendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function apiCallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const GWL_WNDPROC = (-4)
Private Const WM_CHAR = &H102
Private m_lOldWndProc As Long
Private m_hEdit As Long
Public Sub UCaseEdit(ByVal TxtEdit As Control)
On Error Resume Next
m_hEdit = 0
m_hEdit = GetCtrlHandle(TxtEdit)
If m_hEdit Then
m_lOldWndProc = apiSetWindowLong(m_hEdit, GWL_WNDPROC, AddressOf WindowProc)
End If
End Sub
Private Function GetCtrlHandle(ByVal Ctl As Control) As Long
On Error Resume Next
Err.Clear
Ctl.SetFocus
If Err Then
GetCtrlHandle = 0
Else
GetCtrlHandle = apiGetFocus
End If
On Error GoTo 0
End Function
Private Function WindowProc(ByVal hWnd As Long, ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
Select Case lMsg
Case WM_CHAR
If wParam >= &H61 And wParam <= &H7A Then
Call apiSendMessage(hWnd, WM_CHAR, wParam - &H20, lParam)
Exit Function
End If
End Select
WindowProc = apiCallWindowProc(m_lOldWndProc, hWnd, lMsg, wParam, lParam)
End Function
'------------------------------------------
' Código para el UserForm
'------------------------------------------
Private Sub UserForm_Initialize()
Dim obj As Object
For Each obj In Me.Controls
If InStr(1, obj.Name, "TextBox1") > 0 Then
Call UCaseEdit(obj)
Exit For
End If
Next
Set obj = Nothing
End Sub
Demo: http://www.sendspace.com/file/vrxl2s
Saludos desde Baires, JuanC