VBA Tipp: Mit dem Mausrad im Textfeld scrollen

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Ich möchte in einem Textfeld, das einen langen Text enthält, mit dem Mausrad nach oben und unten scrollen.

Lösung

Das geht mit den folgenden API-Funktionen und einer VBA-Funktion, die in einem allgemeinen (globalen) Modul gespeichert werden.

Option Compare Database
Option Explicit
 
' Quelle: http://www.dbwiki.net/
 
' Konstanten
 
' Für SendMessage, Argument 'wMsg' (Scroll-Richtung)
Private Const WM_HSCROLL        As Long = &H114
Private Const WM_VSCROLL        As Long = &H115
 
' Für SendMessage, Argument 'wParam' (Scroll-Variante)
Private Const SB_LINEUP         As Long = 0
Private Const SB_LINELEFT       As Long = 0
Private Const SB_LINEDOWN       As Long = 1
Private Const SB_LINERIGHT      As Long = 1
Private Const SB_PAGEUP         As Long = 2
Private Const SB_PAGELEFT       As Long = 2
Private Const SB_PAGEDOWN       As Long = 3
Private Const SB_PAGERIGHT      As Long = 3
Private Const SB_THUMBPOSITION  As Long = 4
Private Const SB_THUMBTRACK     As Long = 5
Private Const SB_TOP            As Long = 6
Private Const SB_LEFT           As Long = 6
Private Const SB_BOTTOM         As Long = 7
Private Const SB_RIGHT          As Long = 7
Private Const SB_ENDSCROLL      As Long = 8
 
' API-Funktionen
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
                         ByVal lHwnd As Long, _
                         ByVal wMsg As Long, _
                         ByVal wParam As Long, _
                         lParam As Any) As Long
 
Private Declare Function GetFocus Lib "user32" () As Long
 
 
Public Sub TextfeldScrollen(Feldname As String, _
                            lCount As Long)
 
 ' Quelle: http://www.dbwiki.net/
 
 Dim lngHwnd            As Long
 Dim lngScrollVariante  As Long
 
 If Screen.ActiveControl.Name = Feldname Then
 
   ' Runterscrollen
   If lCount > 0 Then
     lngScrollVariante = SB_LINEDOWN
 
   ' Raufscrollen
   Else
     lngScrollVariante = SB_LINEUP
   End If
 
   ' Handle des aktiven Controls auslesen
   lngHwnd = GetFocus
 
   ' Message an das Textfeld senden
   SendMessage lngHwnd, WM_VSCROLL, lngScrollVariante, 0&
 
 End If
 
End Sub

Aufruf

  • Die Sub-Prozedur TextfeldScrollen wird im Formularereignis Bei Mausrad aufgerufen.
  • Im Textfeld mit dem Namen EinTextfeld kann dann mit dem Mausrad gescrollt werden.
Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
 
 Call TextfeldScrollen("EinTextfeld", Count)
 
End Sub

Weblinks