Well, 96% of people indicated that they want to learn more about creating Slider controls.

So, in this post, I start covering the subject by introducing the ‘simplest’ (maybe not quite, but what you would think would be the simplest) slider control built entirely using a couple label controls and a command button.

I will post a few more articles in the coming days that will cover other possibilities:

• Multi-range slider
• Legacy Web Browser slider
• Modern Web Browser slider

A (User)Form and VBA Based Slider

The Basic Setup

The Code

Option Compare Database
Option Explicit

' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Form/VBA based slider control for numeric entry
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: None required
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         unknown
' 2         2024-06-23              Totoal revamp of the entire code base
'                                   Added coloring
'                                   Added option to hide caption
'---------------------------------------------------------------------------------------
Private iSliderMinValue       As Integer
Private iSliderMaxValue       As Integer
Private iSliderTotalRangeValue As Integer
Private Const bOmitSliderCaption As Boolean = False 'Display counter in Slider after selection is made
Private Const bApplyColor As Boolean = True 'Apply Custom coloring


Private Sub cmd_SliderBtn_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        Call CmdBtn_Update(X, Me.lbl_Slider, Me.lbl_SliderProgress, Me.cmd_SliderBtn)
    End If
End Sub

Private Sub cmd_SliderBtn_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        Me.SomeValue = Me.lbl_Slider.Caption
        Call CmdBtn_Update(X, Me.lbl_Slider, Me.lbl_SliderProgress, Me.cmd_SliderBtn, bOmitSliderCaption)
    End If
End Sub

Private Sub Form_Load()
    iSliderMinValue = -50
    iSliderMaxValue = 100
    iSliderTotalRangeValue = iSliderMaxValue - iSliderMinValue
    
    Me.lbl_SliderProgress.Left = Me.lbl_Slider.Left
    Me.lbl_SliderProgress.Top = Me.lbl_Slider.Top + (Me.lbl_Slider.Height - Me.lbl_SliderProgress.Height) / 2
    Me.cmd_SliderBtn.Top = Me.lbl_Slider.Top
    
    If IsNull(Me.SomeValue) Then Me.SomeValue = 0 ' Some value in the range, ***** You may not want this! *****
    Me.SomeValue_AfterUpdate
    If bApplyColor Then Call ApplyProgressColor
End Sub

Private Sub lbl_Slider_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        Call SliderProgress_Update(X, Me.lbl_Slider, Me.lbl_SliderProgress, Me.cmd_SliderBtn)
    End If
End Sub

Private Sub lbl_Slider_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        Call SliderProgress_Update(X, Me.lbl_Slider, Me.lbl_SliderProgress, Me.cmd_SliderBtn)
    End If
End Sub

Private Sub lbl_Slider_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        Me.SomeValue = Me.lbl_Slider.Caption
        Call SliderProgress_Update(X, Me.lbl_Slider, Me.lbl_SliderProgress, Me.cmd_SliderBtn, bOmitSliderCaption)
    End If
End Sub

Public Sub SomeValue_AfterUpdate()
    Me.lbl_SliderProgress.Width = ((Me.SomeValue - iSliderMinValue) / iSliderTotalRangeValue) * Me.lbl_Slider.Width
    If bOmitSliderCaption Then
        Me.lbl_Slider.Caption = ""
    Else
        Me.lbl_Slider.Caption = Me.SomeValue
    End If
    Me.cmd_SliderBtn.Left = Me.lbl_SliderProgress.Left + Me.lbl_SliderProgress.Width
End Sub






Private Sub SliderProgress_Update(X As Single, _
                      oSlider As Access.Label, _
                      oSliderProgress As Access.Label, _
                      oSliderBtn As Access.CommandButton, _
                      Optional bOmitCaption As Boolean = False)
    If X > oSlider.Width Then X = oSlider.Width
    If X < 0 Then X = 0
    oSliderProgress.Width = X

    If bOmitCaption Then
        oSlider.Caption = ""
    Else
        oSlider.Caption = Round((CDbl(iSliderTotalRangeValue) * oSliderProgress.Width / oSlider.Width) + iSliderMinValue)    'cdbl() -> Access arithmetic hack!!!
    End If
    
    oSliderBtn.Left = Me.lbl_SliderProgress.Left + Me.lbl_SliderProgress.Width
    
   If bApplyColor Then Call ApplyProgressColor
End Sub

Private Sub CmdBtn_Update(X As Single, _
                             oSlider As Access.Label, _
                             oSliderProgress As Access.Label, _
                             oSliderBtn As Access.CommandButton, _
                             Optional bOmitCaption As Boolean = False)
    Dim lSliderValue          As Long

    X = oSliderBtn.Left + X
    If X > oSlider.Left + oSlider.Width - (oSliderBtn.Width / 2) Then X = oSlider.Left + oSlider.Width - (oSliderBtn.Width / 2)
    If X < oSlider.Left - (oSliderBtn.Width / 2) Then X = oSlider.Left - (oSliderBtn.Width / 2)
    oSliderBtn.Left = X

    oSliderProgress.Width = oSliderBtn.Left - oSlider.Left + (oSliderBtn.Width / 2)

    lSliderValue = Round((CDbl(iSliderTotalRangeValue) * oSliderProgress.Width / oSlider.Width) + iSliderMinValue) 'cdbl() -> Access arithmetic hack!!!
    
    If bOmitCaption Then
        oSlider.Caption = ""
    Else
        oSlider.Caption = lSliderValue
    End If

    If bApplyColor Then Call ApplyProgressColor
End Sub

Private Sub ApplyProgressColor()
    'For Fun!
    Dim lBottomThird          As Long
    Dim lUpperThird           As Long

    lBottomThird = iSliderMinValue + iSliderTotalRangeValue / 3
    lUpperThird = iSliderMaxValue - iSliderTotalRangeValue / 3
    Select Case CLng(Me.lbl_Slider.Caption)
        Case iSliderMinValue To lBottomThird
            Me.lbl_SliderProgress.BackColor = RGB(230, 0, 38) 'Red
        Case lUpperThird To iSliderMaxValue
            Me.lbl_SliderProgress.BackColor = RGB(34, 204, 0) 'green
        Case Else
            Me.lbl_SliderProgress.BackColor = RGB(255, 170, 0) 'Yellow
    End Select
End Sub

With this version you can click on the command button and adjust the slider, or you can also click anywhere along the slider to adjust the value. You can also, enter the value in the Textbox and the slider will adjust automatically to represent the new value.
 

Demo Database

Feel free to download a 100% unlocked copy of a sample database I have put together by using the link provided below:

Notice About Content/Downloads/Demos

Disclaimer/Notes:

Microsoft Access 2010 Runtime
Microsoft Access 2013 Runtime
Microsoft Access 2016 Runtime
Microsoft 365 Access Runtime

A Final Word

Lastly, because this uses standard controls and VBA, do note that this can also be implemented in UserForms! So this can be implemented in Excel, Word, … This is not limited to Access!!!