在Access表单中使用鼠标滚轮滚动到备忘录框或组合框

huangapple go评论92阅读模式
英文:

Using Mouse Wheel into the Memo Box or Combo Box in Access Forms

问题

我有一个名为“NewStaff”的Access表单,其中包含一个备忘录框。当我点击其中时,滚动鼠标滚轮会导致退出该字段,并且不会放置在备忘录框内的文本上。最后,我将以下代码放在表单的鼠标滚轮事件上,现在我可以通过滚动鼠标滚轮来移动备忘录框的行。

  1. Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
  2. Dim i As Long
  3. Dim s As String
  4. If Me.ActiveControl.Name = "NewStaff" Then
  5. If Count > 0 Then
  6. For i = 1 To Count
  7. s = s & "{DOWN}"
  8. Next i
  9. Else
  10. For i = 1 To -Count
  11. s = s & "{UP}"
  12. Next i
  13. End If
  14. SendKeys s
  15. End If
  16. End Sub

问题在于光标会跳跃三行到三行最终离开该字段

是否有一种逐行移动并保持在备忘录框内的方法?...谢谢

英文:

I have an Access form named "NewStaff" that contains a Memo box. When I clicked inside it, rolling the mouse wheel would cause an exit to this field and it would not be placed on the text inside the Memo box. Finally, I put the following code on the MouseWheel Event form and now I can move the Memo box lines by rolling the mouse wheel.

> Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
> Dim i As Long
> Dim s As String
> If Me.ActiveControl.Name = "ُNewStaff" Then
> If Count > 0 Then
> For i = 1 To Count
> s = s & "{DOWN}"
> Next i
> Else
> For i = 1 To -Count
> s = s & "{UP}"
> Next i
> End If
> SendKeys s
> End If
> End Sub

The problem is that the cursor has jumping three lines to three lines and finally leaves the field!

Is there a way to go line by line and stay in Memo box for the cursor? ... Thanks

答案1

得分: 2

使用SendKeys UP/DOWN来滚动文本不够灵活 - 用户不一定希望光标移动,只需要文本滚动。另外,你提到的“突然退出”效果。

很久以前,我找到并适应了这个解决方案。将所有代码粘贴到一个模块中,并按照注释中所示进行调用。

  1. Option Compare Database
  2. Option Explicit
  3. Private Const WM_VSCROLL = &H115
  4. Private Const SB_LINEUP = 0
  5. Private Const SB_LINEDOWN = 1
  6. Public Declare Function SendMessage Lib "user32" _
  7. Alias "SendMessageA" _
  8. (ByVal hWnd As Long, _
  9. ByVal wMsg As Long, _
  10. ByVal wParam As Long, _
  11. lParam As Any) _
  12. As Long
  13. Private Declare Function apiGetFocus Lib "user32" _
  14. Alias "GetFocus" _
  15. () As Long
  16. '
  17. ' 用鼠标滚轮滚动多行文本框。文本框必须具有焦点。
  18. '
  19. ' 在包含多行文本框的表单的MouseWheel事件中调用此子例,如下所示:
  20. '
  21. ' Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
  22. ' Call MouseWheelScroll(Count)
  23. ' End Sub
  24. '
  25. ' 来源
  26. ' http://www.access-programmers.co.uk/forums/showthread.php?t=195679
  27. ' http://www.extramiledata.com/scroll-microsoft-access-text-box-using-mouse-wheel/
  28. Public Sub MouseWheelScroll(ByVal Count As Long)
  29. Dim LinesToScroll As Integer
  30. Dim hwndActiveControl As Long
  31. If Screen.ActiveControl.Properties.Item("ControlType") = acTextBox Then
  32. hwndActiveControl = fhWnd(Screen.ActiveControl)
  33. For LinesToScroll = 1 To Abs(Count)
  34. SendMessage hwndActiveControl, WM_VSCROLL, IIf(Count < 0, SB_LINEUP, SB_LINEDOWN), 0&
  35. Next
  36. End If
  37. End Sub
  38. ' 来源: http://access.mvps.org/access/api/api0027.htm
  39. ' 代码由 Dev Ashish 提供
  40. Private Function fhWnd(ctl As Control) As Long
  41. On Error Resume Next
  42. ' 我们只在Screen.ActiveControl中使用此函数,因此这不是必要的。
  43. ' 我记不清是否在某些情况下发现它有害。
  44. ' ctl.SetFocus
  45. fhWnd = apiGetFocus
  46. On Error GoTo 0
  47. End Function

希望这能帮助你。

英文:

Using SendKeys UP/DOWN to scroll is clunky - users don't necessarily want the cursor to move, only the text to scroll. Plus the "sudden exit" effect you noticed.

A long time ago I found and adapted this solution.
Paste all the code into a module, and call it as shown in the comments.

  1. Option Compare Database
  2. Option Explicit
  3. Private Const WM_VSCROLL = &amp;H115
  4. Private Const SB_LINEUP = 0
  5. Private Const SB_LINEDOWN = 1
  6. Public Declare Function SendMessage Lib &quot;user32&quot; _
  7. Alias &quot;SendMessageA&quot; _
  8. (ByVal hWnd As Long, _
  9. ByVal wMsg As Long, _
  10. ByVal wParam As Long, _
  11. LParam As Any) _
  12. As Long
  13. Private Declare Function apiGetFocus Lib &quot;user32&quot; _
  14. Alias &quot;GetFocus&quot; _
  15. () As Long
  16. &#39;
  17. &#39; Scroll multi-line textboxes with the mouse wheel. The textbox must have the focus.
  18. &#39;
  19. &#39; Call this sub in the MouseWheel event of the form(s) containing multi-line textboxes, like this:
  20. &#39;
  21. &#39; Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
  22. &#39; Call MouseWheelScroll(Count)
  23. &#39; End Sub
  24. &#39;
  25. &#39; Sources
  26. &#39; http://www.access-programmers.co.uk/forums/showthread.php?t=195679
  27. &#39; http://www.extramiledata.com/scroll-microsoft-access-text-box-using-mouse-wheel/
  28. Public Sub MouseWheelScroll(ByVal Count As Long)
  29. Dim LinesToScroll As Integer
  30. Dim hwndActiveControl As Long
  31. If Screen.ActiveControl.Properties.Item(&quot;ControlType&quot;) = acTextBox Then
  32. hwndActiveControl = fhWnd(Screen.ActiveControl)
  33. For LinesToScroll = 1 To Abs(Count)
  34. SendMessage hwndActiveControl, WM_VSCROLL, IIf(Count &lt; 0, SB_LINEUP, SB_LINEDOWN), 0&amp;
  35. Next
  36. End If
  37. End Sub
  38. &#39; Source: http://access.mvps.org/access/api/api0027.htm
  39. &#39; Code Courtesy of Dev Ashish
  40. Private Function fhWnd(ctl As Control) As Long
  41. On Error Resume Next
  42. &#39; We only use this function for Screen.ActiveControl, so this is not necessary.
  43. &#39; I can&#39;t remember if I found it harmful in some situations.
  44. &#39; ctl.SetFocus
  45. fhWnd = apiGetFocus
  46. On Error GoTo 0
  47. End Function

答案2

得分: 1

这是一个鼠标设置:

英文:

I believe that's a mouse setting:

在Access表单中使用鼠标滚轮滚动到备忘录框或组合框

答案3

得分: 0

好的,我找到了一个问题的解决方案。在鼠标设置(鼠标属性)中跳“三行到三行”的问题在Windows控制面板中,它默认为数字三。我们必须将其更改为数字一!

路径:控制面板 > 鼠标属性 > 滚轮

现在,我们只需修复突然退出备忘录框的问题!

英文:

Well, I found a solution to one of the problems. The problem of jumping "three lines to three lines" in the mouse settings (Mouse Properties) was in the Windows Control Panel, which by default is on the number three. We have to change it to number one!

Path: Control Panel > Mouse Properties > Wheel

在Access表单中使用鼠标滚轮滚动到备忘录框或组合框

Now, We just have to fix the sudden exit from the Memo box!

huangapple
  • 本文由 发表于 2023年5月7日 18:08:25
  • 转载请务必保留本文链接:https://go.coder-hub.com/76193253.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定