如何编写控件以减少VBA代码模块中的单元格值

Question

我有一个代码模块,我在其中创建一个文本框,按下一个特定的键,并按文本框中插入的数量减少当前选定的单元格值.我来到了创建文本框的位置.现在我需要访问Worksheet模块外部的文本框的事件.我发现我可以使用WihtEvents属性创建一个类模块.不幸的是,这似乎不起作用.这里执行以执行控制的代码:

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

类模块的代码:

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

我在文本框中写的没有事件被触发.哪里出错了？

Answer 1

要从 VBA 用户窗体中删除标题栏，您需要使用 API 的FindWindow、SetWindowLong、GetWindowLong和SetWindowPos。这是我获取 API 的一站式平台

创建您的用户表单并在其中放置一个文本框。例如

接下来将此代码粘贴到用户表单中。

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

当您现在运行用户表单时，它将如下所示。由于我们删除了用户窗体的标题栏，因此我添加了一段代码，以便当您ESC从文本框中按下时，用户窗体将卸载。您可以将其更改为您喜欢的任何（合理的）。