How to write a control to reduce the cell value in a VBA code module

Question

I have a code module where I create a text box with pressing a specific key and reduce the current selected cell value by the amount inserted in the text box. I came to the point where I created the text box. Now I need to access the events of the text box outside the Worksheet modules. I found out that I could create a class module with the WihtEvents property. Unfortunate this does not seem to work. Here the code which is executed to make the control:

Dim objControl As BankingEventSink

Private Sub ReduceCell()
    If IsNumeric(ActiveCell.Text) Then
        Dim value As Double
        value = CDbl(ActiveCell.Text)
        ActiveSheet.Shapes.AddOLEObject(ClassType:="Forms.TextBox.1").Name = "ReduceCellTextBox"
        With ActiveSheet.OLEObjects("ReduceCellTextBox")
            .Top = ActiveCell.Top + ActiveCell.Height
            .Left = ActiveCell.Left
        End With
        ActiveSheet.OLEObjects("ReduceCellTextBox").Activate
        Set objControl = New BankingEventSink
        objControl.Init (ActiveSheet.OLEObjects("ReduceCellTextBox").Object)
    Else
        RethrowKeys ("{BS}{-}")
    End If
End Sub

The code of the class module:

Dim WithEvents objOLEControl As MSForms.TextBox

Public Sub Init(oleControl As MSForms.TextBox)
    Set objOLEControl = oleControl
End Sub

Private Sub ReduceCellTextBox_Change()
    MsgBox "Changed"
End Sub

Private Sub ReduceCellTextBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
                                   ByVal Shift As Integer)
    MsgBox "Key down: " & KeyCode
End Sub

What ever I write in the text box no event is triggered. Where is the mistake?

Answer 1

To remove the title bar from a VBA userform, you need to use API's FindWindow, SetWindowLong, GetWindowLong and SetWindowPos. HERE is my one stop place for APIs

Create your userform and place a textbox in it. For example

Next paste this code in the userform.

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) 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 GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long) As Long

Private Declare Function SetWindowPos Lib "user32" ( _
ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const GWL_STYLE = (-16)
Private Const WS_CAPTION = &HC00000
Private Const WS_BORDER = &H800000

Private Enum ESetWindowPosStyles
    SWP_SHOWWINDOW = &H40
    SWP_HIDEWINDOW = &H80
    SWP_FRAMECHANGED = &H20
    SWP_NOACTIVATE = &H10
    SWP_NOCOPYBITS = &H100
    SWP_NOMOVE = &H2
    SWP_NOOWNERZORDER = &H200
    SWP_NOREDRAW = &H8
    SWP_NOREPOSITION = SWP_NOOWNERZORDER
    SWP_NOSIZE = &H1
    SWP_NOZORDER = &H4
    SWP_DRAWFRAME = SWP_FRAMECHANGED
    HWND_NOTOPMOST = -2
End Enum

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Dim FrmWndh  As Long, lStyle As Long
Dim tR As RECT

Private Sub UserForm_Activate()
    FrmWndh = FindWindow(vbNullString, Me.Caption)

    lStyle = GetWindowLong(FrmWndh, GWL_STYLE)

    lStyle = lStyle And Not WS_CAPTION
    SetWindowLong FrmWndh, GWL_STYLE, lStyle

    SetWindowPos FrmWndh, 0, tR.Left, tR.Top, _
    tR.Right - tR.Left, tR.Bottom - tR.Top, _
    SWP_NOREPOSITION Or SWP_NOZORDER Or SWP_FRAMECHANGED Or WS_BORDER

    Me.Repaint
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 27 Then Unload Me
End Sub

When you now run the userform, it will look like this. Since we have removed the userform's title bar, I have added a code so that when you press ESC from the textbox, the userform will unload. You can change that to whatever (reasonable) you like.