Vba excel скроллинг формы

UserForm Controls — ScrollBar and SpinButton

UserForm acts as a container in which you add multiple ActiveX controls, each of which has a specific use and associated properties. By itself, a UserForm will not be of much use unless ActiveX controls are added to it which are the actual user-interactive objects. Using ActiveX Controls on a Worksheet have been illustrated in detail, in the separate section of «Excel VBA: ActiveX Controls, Form Controls & AutoShapes on a Worksheet».

Also refer «2. UserForm and Controls — Properties» for properties common to the UserForm and most Controls

Note: In below given examples, vba codes are required to be entered in the Code Module of the UserForm, unless specified otherwise.

——————————————-

Contents:

ScrollBar Control

SpinButton Control

——————————————-

ScrollBar Control

A ScrollBar control enables to change (increment or decrement) the value displayed by other UserForm controls (viz. TextBox, Label, …) or the value in a worksheet range. It scrolls through a range of values when a user: (i) clicks on the scroll arrows; (ii) drags the scroll box; or (iii) clicks in an area between a scroll arrow and the scroll box. ScrollBar & SpinButton controls — the difference between the two is that the ScrollBar box can be dragged to change the control’s value over larger increments (while keeping the increment low for clicks) which advantages a ScrollBar to make a selection from across a large number of values and cover an extremely wide range.

SmallChange Property specifies the incremental change, as an integer value (Long variable), that occurs when a user clicks the scroll arrow. The LargeChange Property specifies the incremental change when the user clicks between a scroll arrow and the scroll box. The default value is 1 for both the properties.

Min and Max Properties are integer values (Long variable) which specify the minimum and maximum acceptable values of the ScrollBar control (for the Value property setting). In a vertical ScrollBar clicking down the scroll arrow increases the value and the lowest position displays the maximum value (will be reverse when you click up the scroll arrow). In a horizontal ScrollBar clicking the right scroll arrow increases the value and the rightmost position displays the maximum value (will be reverse when you click the left scroll arrow).

Orientation Property determines a vertical ScrollBar or a horizontal ScrollBar. It has 3 settings: (i) fmOrientationAuto (Value -1) — this is the default value wherein the ScrollBar dimensions automatically determine whether the ScrollBar is Vertical or Horizontal. Where width is more than height, ScrollBar is Horizontal and where height is more than width, ScrollBar is Vertical; (ii) FmOrientationVertical (Value 0) — vertical ScrollBar; and (iii) FmOrientationHorizontal (Value 1) — horizontal ScrollBar.

Example 1: Creating a Mortgage Calculator, using ScrollBar controls. Refer Image 29. See vba codes below: 

Private Sub UserForm_Initialize()
‘Set properties of Controls on initialization of UserForm.

‘set properties for controls in re of Loan Amount:
TextBox1.BackColor = RGB(255, 255, 0)
TextBox1.TextAlign = fmTextAlignCenter
TextBox1.Font.Bold = True
TextBox1.Enabled = False

Label1.Caption = «Loan Amount ($):»
Label1.TextAlign = fmTextAlignLeft

ScrollBar1.Min = 0
ScrollBar1.Max = 10000
ScrollBar1.Orientation = fmOrientationHorizontal
ScrollBar1.SmallChange = 5
ScrollBar1.LargeChange = 100
ScrollBar1.Value = 0

‘set properties for controls in re of Annual Interest Rate:
TextBox2.BackColor = RGB(255, 255, 0)
TextBox2.TextAlign = fmTextAlignCenter
TextBox2.Font.Bold = True
TextBox2.Enabled = False

Label2.Caption = «Annual Int Rate (%):»
Label2.TextAlign = fmTextAlignLeft

ScrollBar2.Min = 0
ScrollBar2.Max = 1000
ScrollBar2.Orientation = fmOrientationHorizontal
ScrollBar2.SmallChange = 1
ScrollBar2.LargeChange = 10
ScrollBar2.Value = 0

‘set properties for controls in re of Loan Tenure:
TextBox3.BackColor = RGB(255, 255, 0)
TextBox3.TextAlign = fmTextAlignCenter
TextBox3.Font.Bold = True
TextBox3.Enabled = False

Label3.Caption = «Loan Tenure (Yrs)»
Label3.TextAlign = fmTextAlignLeft

ScrollBar3.Min = 0
ScrollBar3.Max = 50
ScrollBar3.Orientation = fmOrientationHorizontal
ScrollBar3.SmallChange = 1
ScrollBar3.LargeChange = 4
ScrollBar3.Value = 0

‘set properties for Label which displays Monthly Instalment:
Label4.Caption = «Monthly Instalment: $»
Label4.TextAlign = fmTextAlignCenter
Label4.BackColor = RGB(0, 255, 0)
Label4.Font.Bold = True

End Sub

Private Sub ScrollBar1_Change()

‘in re of Loan Amount, clicking the scroll arrow will increment amount by $5,000 and clicking between a scroll arrow and the scroll box will increment amount by $100,000:
TextBox1.Value = ScrollBar1.Value * 1000
TextBox1.Value = «$» & Format(TextBox1.Value, «#,##0»)

End Sub

Private Sub ScrollBar2_Change()

‘in re of Annual Interest Rate, clicking the scroll arrow will increment rate by 0.1% and clicking between a scroll arrow and the scroll box will increment rate by 1%:
TextBox2.Value = ScrollBar2.Value / 10

End Sub

Private Sub ScrollBar3_Change()

‘in re of Loan Tenure, clicking the scroll arrow will increment year by 0.5 and clicking between a scroll arrow and the scroll box will increment year by 2:
TextBox3.Value = ScrollBar3.Value / 2

End Sub

Private Sub CommandButton1_Click()
‘calculates the Monthly Instalment using the excel PMT function:

Dim mi As Currency

If Not TextBox1.Value > 0 Then

MsgBox «Please Enter Loan Amount!»

Exit Sub

ElseIf Not TextBox2.Value > 0 Then

MsgBox «Please Enter Annual Interest Rate!»

Exit Sub

ElseIf Not TextBox3.Value > 0 Then

MsgBox «Please Enter Loan Tenure!»

Exit Sub

Else

mi = Pmt((TextBox2.Value / 100) / 12, TextBox3.Value * 12, TextBox1.Value)

‘Label displays the monthly instalment, rounded off to 2 decimal points:

Label4.Caption = «Monthly Instalment: $» & Round(mi, 2) * -1

End If

End Sub

Private Sub CommandButton2_Click()
‘close button unloads the UserForm

Unload Me

End Sub

————————————————————————————————————-

SpinButton Control

A SpinButton control, similar to a ScrollBar control, is used to increment or decrement the value (viz. a number, date, time, etc.) displayed by other UserForm controls (viz. TextBox, Label, …) or the value in a worksheet range. A SpinButton control (also referred to as a Spinner control) functions like a ScrollBar control, with similar properties (viz. SmallChange, Min, Max, Orientation, …). SmallChange Property specifies the incremental change, as an integer value (Long variable), that occurs when a user clicks the scroll arrow. A SpinButton control does not have a LargeChange property, like in a ScrollBar. In a vertical ScrollBar clicking up the scroll arrow decreases the value whereas clicking up the scroll arrow on a vertical Spinner increases the value.

ScrollBar & SpinButton controls — the difference between the two is that the ScrollBar box can be dragged to change the control’s value over larger increments (while keeping the increment low for clicks) which advantages a ScrollBar to make a selection from across a large number of values and cover an extremely wide range.

Example 2: Using a SpinButton control to change dates in TextBox, within a specified range:

Private Sub UserForm_Initialize()
‘populate a date in the TextBox

Dim dt As Date

‘disallow manual input in TextBox
TextBox1.Enabled = False

dt = «09/15/2011»
TextBox1.Text = dt

End Sub

Private Sub SpinButton1_SpinUp()
‘increase date by one day at a time, within the same month:

Dim dtUpper As Date

dtUpper = «09/30/2011»

If DateValue(TextBox1.Text) < dtUpper Then

TextBox1.Text = DateValue(TextBox1.Text) + 1

End If

End Sub

Private Sub SpinButton1_SpinDown()
‘decrease date by one day at a time, within the same month:

Dim dtLower As Date

If DateValue(TextBox1.Text) > dtLower Then

TextBox1.Text = DateValue(TextBox1.Text) — 1

End If

End Sub

Example 3: Move ListBox Items Up/Down in the list order and in the worksheet range, using the SpinButton control (by clicking Up or Down the scroll arrow). Refer Image 30. See below vba codes:

 Private Sub loadListBox()
‘load ListBox from worksheet range:

Dim n As Integer
Dim cell As Range
Dim rng As Range

    
Set rng = Sheet7.Range(«A1:A6»)

For n = 1 To ListBox1.ListCount

ListBox1.RemoveItem ListBox1.ListCount — 1

Next n

For Each cell In rng.Cells

Me.ListBox1.AddItem cell.Value

Next cell

End Sub

Private Sub UserForm_Initialize()
‘loads ListBox on initializing of UserForm

loadListBox

End Sub

Private Sub SpinButton1_SpinUp()
‘clicking up the scroll arrow moves the selected ListBox item one up both in the list order and also in the linked worksheet range:

Dim n As Long

n = ListBox1.ListIndex

If n > 0 Then

Sheet7.Range(«A» & n + 1).Value = Sheet7.Range(«A» & n).Value
Sheet7.Range(«A» & n).Value = ListBox1.Value

loadListBox

ListBox1.Selected(n — 1) = True

ElseIf ListBox1.ListIndex = 0 Then

MsgBox «First Item cannot be moved Up!»

Else

MsgBox «Please select item!»

End If

End Sub

Private Sub SpinButton1_SpinDown()
‘clicking down the scroll arrow moves the selected ListBox item one down both in the list order and also in the linked worksheet range:

Dim n As Long

n = ListBox1.ListIndex

If n >= 0 And n < ListBox1.ListCount — 1 Then

Sheet7.Range(«A» & n + 1).Value = Sheet7.Range(«A» & n + 2).Value
Sheet7.Range(«A» & n + 2).Value = ListBox1.Value

loadListBox

ListBox1.Selected(n + 1) = True

ElseIf ListBox1.ListIndex = ListBox1.ListCount — 1 Then

MsgBox «Last Item cannot be moved Down!»

Else

MsgBox «Please select item!»

End If

End Sub

Private Sub CommandButton1_Click()
‘clicking the Close button unloads the UserForm

Unload Me

End Sub

Some times we need to use very large userforms in our VBA projects. Size of the form depends on the number of fields and various objects we have in our form.  And if we need to show them in one window, we need to create big userform to put them all. You can create a form of any size by giving appropriate values for Height and width in properties window. But if our userform is bigger than the screen we need to use scroll bars inside our form. It is easier to put a scroll bar to a userform. But I saw that many people have problems with setting scroll bars correctly. Lot of people say that their scroll bars not working at run time. So there are few important things you should know when using scroll bars.

I will explain these important facts using a simple example. I have created a large form which has height of 1200 and width of 420. And there are a lot of text fields inside my userform.

If you look at properties window, you will notice that ScrollBars value is set to 0-fmScrollBarsNone by default. So we need to change this property depending on our requirement. If you have a userform with larger width, then you need to set ScrollBars value to 1-fmScrollBarsHorizontal. If you have a userform which has higher height, then you need to set this value to 2-fmScrollBarsVertical. And if you need scroll bars in both directions you can set the value to 3-fmScrollBarsBoth. You need to set to this value only if both width and height of your form is bigger than the screen.

You should set ScrollTop value to the 0. So then it will always appear at top.

Finally you need to set the ScrollHeight. It is very important to set appropriate value to this. Othewise you may not able to scroll up to the bottom of the form. Also if you set higher value, then user will scroll after the end of the objects. So user will see like your form is extended more than needed. So you should set a optimum value for this property for correct functionality and nice appearance. For example if you have a form having a height of 1200, you should set ScrollHeight value around 1850.

Элемент управления ScrollBar представляет из себя всем знакомую полосу прокрутки, которая встречается в текстовых полях, когда их содержимое не умещается на поверхности. Только в данном случае, его логика работы немного меняется.

VBA Объект ScrollBar удобно использовать, когда нужно увеличить или уменьшить диапазон. Так, можно с его помощью задавать диапазон для вычисления суммы чисел, или, в зависимости от положения ползунка менять цвет текста. Понятно, что в этом случае удобно использовать цикл for. Примером использования объекта ScrollBar VBA может служить регулятор громкости, контраста и так далее.

Базовые свойства класса ScrollBar VBA

Max  и  Min – данные свойства позволяют задать максимальное и минимальное значение, которые вы сможете определить используя данные элемент управления. Свойство принимает только целые значения в диапазоне от −32 767  до +32 767. Вы можете задавать значения как в прямом порядке (от меньшего к большего) так и в обратном (от большего к меньшему). В таких случаях ползунок нужно будет тянуть в том или ином направлении.

SmallChange – свойство vba принимает целое значение, которое определяет, на какую величину будет перемещаться ползунок при нажатии на кнопки прокрутки.

LargeChange – как и свойство SmallChange позволяет задать шаг перемещения ползунка при нажатии на полосу прокрутки. Значения могут быть в диапазоне от −32 767  до +32 767, по умолчанию значения равны для обоих свойств 1.

Orientation – свойство позволяет указать ориентацию ползунка – горизонтальную или вертикальную. По умолчанию значение ровно 1 – ориентация определяется автоматически исходя из параметров формы, то есть, как полоса прокрутки умещается на объекте UserForm. Можно и явно указать ориентацию объекта ScrollBar, -1 – горизонтальная ориентация и 0 – вертикальная.

Visible – собственно, определяет видимость vba компонента ScrollBar, значение true установлено по умолчанию – объект видим, и false – скрываем элемент управления от глаз пользователя.

Value – позволяет получить значение ползунка, в зависимости от его положения.

Как и большинства элементов управления, основным событием для ScrollBar VBA является событие Change, которое возникает при перемещении ползунка.

Теперь настало время приступить к практике

Откройте редактор Visual Basic (Alt + F11), и в окно редактора Проектов добавьте новую форму и модуль, я назвал форму ScrollForm и модуль ScrollModule, за имя отвечает свойство Name. В редакторе кода для модуля пропишите код:

Sub ScrollModule()
    ScrollForm.Show
End Sub

Тут мы определяем, что при запуске модуля (макроса) с именем ScrollModule надо показать форму с именем ScrollForm, свойство Show делает объекта класса UserForm видимым.

Теперь на поверхности формы нам нужно расположить следующие элементы управления:

Label1 – метка, в которой пропишем текст “Полоса прокрутки”

ScrollBar1 – полоса прокрутки, которая размещается под меткой, она должна быть горизонтальной. С ее помощью мы будет задавать диапазон значений от 1 до 100, и потом будем вычислять сумму заданных чисел.

Label2 – вторая метка, удалите в ней весь текст, в ней мы будет отображать результат суммирования.

Теперь в редакторе кода для формы пропишем следующие процедуры:

Private Sub ScrollBar1_Change()
Dim summ
    summ = 1
    ' вычисляем сумму чисел
    For i = 1 To ScrollBar1.Value
        summ = summ + i
    Next
    Label2.Caption = "Сумма чисел от 1 до " & ScrollBar1.Value & " ровна: " & summ
End Sub
 
Private Sub UserForm_Initialize()
Dim summ
    summ = 1
    ' вычесляем сумму чисел
    For i = 1 To ScrollBar1.Value
        summ = summ + i
    Next
    ' параметры первого текстового поля
    Label1.FontSize = 15
    Label1.ForeColor = &HCD
    Label1.TextAlign = fmTextAlignCenter
    ' параметры полосы прокрутки
    ScrollBar1.Min = 1
    ScrollBar1.Max = 100
    ' параметры второго текстового поля
    Label2.FontSize = 15
    Label2.ForeColor = &HFF0000
    Label2.TextAlign = fmTextAlignCenter
    Label2.Caption = "Сумма чисел от 1 до " & ScrollBar1.Value & " ровна: " & summ
End Sub

ScrollBar1_Change – тут происходит обработка события Change. В цикле происходит суммирование чисел от 1 до ScrollBar1.Value. Тут ScrollBar1.Value содержит выбранное значение на полосе прокрутки, результат суммирования будет хранить переменная summ. Также в свойство Caption объекта Label2 записывается результат суммирования.

UserForm_Initialize – тут происходит определение начальных свойств при инициализации формы.  Размер и текст меток, задается минимальное (один) и максимальное (сто) значение для полос прокрутки. Тут также используется цикл для суммирования значений.

И так, давайте просуммируем: мы рассмотрели пример использования объекта класса ScrollBar VBA языка, который позволяет добавлять на поверхность формы UserForm полосу прокрутки.

Workbook demo

The following generic code enables MouseWheel scrolling for UserForms and Frames … You just need to pass the UserForm or the Frame to the SetScrollHook routine in the UserForm_Activate event as follows :

Private Sub UserForm_Activate()
    [COLOR=#008000]'Call SetScrollHook(Me)           '.. Apply the mousewheel scrolling to the Userform[/COLOR]
    Call SetScrollHook(Me.Frame1)     [COLOR=#008000]'.. Apply the mousewheel scrolling to the Frame[/COLOR]
End Sub

You can’t apply the mousewheel functionality to more than one object simultaniously (I’ll try to modify the code later to make it work with the userform and with different frames within the form simultaniously)

In order to scroll the frame

horizontally

, have the Ctl key held down

Proceedings:

1- Create a new UserForm (UserForm1) and add a frame to it (Frame1)

2- Place this code in the UserForm Module :

Private Sub UserForm_Activate()
    'Call SetScrollHook(Me)           '.. Apply the mousewheel scrolling to the Userform
    Call SetScrollHook(Me.Frame1)     '.. Apply the mousewheel scrolling to the Frame
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    RemoveScrollHook
End Sub

3- Add a Standard Module to the project and place the following code in it:

Option Explicit

Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Type MOUSEHOOKSTRUCT
    pt As POINTAPI
    hwnd As Long
    wHitTestCode As Long
    dwExtraInfo As Long
End Type

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const HC_ACTION As Long = 0
Private Const POINTSPERINCH As Long = 72
Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90
Private Const SCROLL_CHANGE As Long = 5

Private lMouseHook As Long
Private lFormHwnd As Long
Private bHookIsSet As Boolean
Private oScrollableObject As Object


Public Sub SetScrollHook(ByVal ScrollableObject As Object)
    If Not (IsObjectUserForm(ScrollableObject) Or TypeName(ScrollableObject) = "Frame") Then Exit Sub
    Set oScrollableObject = ScrollableObject
    lFormHwnd = GetActiveWindow
    With ScrollableObject
        .ScrollBars = fmScrollBarsBoth
        .KeepScrollBarsVisible = fmScrollBarsBoth
        .PictureAlignment = fmPictureAlignmentTopLeft
        ' Adjust the values of the scroll width and height properties as required
        .ScrollWidth = ScrollableObject.InsideWidth * 3
        .ScrollHeight = ScrollableObject.InsideHeight * 2
    End With
    If Not bHookIsSet Then
        lMouseHook = SetWindowsHookEx( _
        WH_MOUSE_LL, AddressOf MouseProc, Application.Hinstance, 0)
        bHookIsSet = lMouseHook <> 0
    End If
End Sub

Public Sub RemoveScrollHook(Optional ByVal Dummy As Boolean)
    If bHookIsSet Then
        UnhookWindowsHookEx lMouseHook
        lMouseHook = 0
        bHookIsSet = False
    End If
End Sub

Private Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, ByRef lParam As MOUSEHOOKSTRUCT) As Long

    Dim tTopLeft As POINTAPI
    Dim tBottomRight As POINTAPI
    Dim tRect As RECT
    
    GetClientRect lFormHwnd, tRect
    With oScrollableObject
        If IsObjectUserForm(oScrollableObject) Then
            tTopLeft.X = tRect.Left
            tTopLeft.Y = tRect.Top
            tBottomRight.X = tRect.Right
            tBottomRight.Y = tRect.Bottom
        Else
            tTopLeft.X = PTtoPX(.Left, False) + tRect.Left
            tTopLeft.Y = PTtoPX(.Top, True) + tRect.Top
            tBottomRight.X = PTtoPX(.Left + .Width, False) + tRect.Left
            tBottomRight.Y = PTtoPX(.Top + .Height, True) + tRect.Top
        End If
    End With
    ClientToScreen lFormHwnd, tTopLeft
    ClientToScreen lFormHwnd, tBottomRight
    SetRect tRect, tTopLeft.X, tTopLeft.Y, tBottomRight.X, tBottomRight.Y
    On Error GoTo errH
    If (nCode = HC_ACTION) And CBool(PtInRect(tRect, lParam.pt.X, lParam.pt.Y)) Then
        If wParam = WM_MOUSEWHEEL Then
            With oScrollableObject
                Select Case GetAsyncKeyState(VBA.vbKeyControl)
                    Case Is = 0 'vertical scroll
                        If lParam.hwnd > 0 Then
                            .ScrollTop = Application.Max(0, .ScrollTop - SCROLL_CHANGE)
                        Else
                            .ScrollTop = Application.Min(.ScrollHeight - .InsideHeight, .ScrollTop + SCROLL_CHANGE)
                        End If
                    Case Else ' horiz scroll when the Ctl key down
                        If lParam.hwnd > 0 Then
                            .ScrollLeft = Application.Max(0, .ScrollLeft - SCROLL_CHANGE)
                        Else
                            .ScrollLeft = Application.Min(.ScrollWidth - .InsideWidth, .ScrollLeft + SCROLL_CHANGE)
                        End If
                End Select
            End With
        End If
    End If
    MouseProc = CallNextHookEx( _
    lMouseHook, nCode, wParam, ByVal lParam)
    Exit Function
errH:
    RemoveScrollHook
End Function

Private Function ScreenDPI(bVert As Boolean) As Long
    Static lDPI(1), lDC
    If lDPI(0) = 0 Then
        lDC = GetDC(0)
        lDPI(0) = GetDeviceCaps(lDC, LOGPIXELSX)
        lDPI(1) = GetDeviceCaps(lDC, LOGPIXELSY)
        lDC = ReleaseDC(0, lDC)
    End If
    ScreenDPI = lDPI(Abs(bVert))
End Function

Private Function PTtoPX _
(Points As Single, bVert As Boolean) As Long
    PTtoPX = Points * ScreenDPI(bVert) / POINTSPERINCH
End Function

Private Function IsObjectUserForm(ByVal obj As Object) As Boolean
    Dim oTemp As Object
    On Error Resume Next
        Set oTemp = obj.Parent
        Set oTemp = Nothing
        IsObjectUserForm = Err.Number = 438
    On Error GoTo 0
End Function