如何编写一个控件来减lessVBA代码模块中的单元格值

我有一个代码模块，我创build一个文本框，按下特定的键，并减less插入文本框中的金额当前选定的单元格值。 我来到了创build文本框的地步。 现在我需要访问工作表模块外的文本框的事件。 我发现我可以用WihtEvents属性创build一个类模块。 不幸的是，这似乎并不奏效。 这里是执行的代码来进行控制：

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的地方

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

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

 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时，用户窗体将被卸载。 你可以改变你喜欢的任何（合理的）。