Control deslizante basado en formularios y VBA: modernización de la interfaz

Bueno, el 96% de las personas indicaron que desean aprender más sobre la creación de controles deslizantes.

Entonces, en esta publicación, comienzo a cubrir el tema presentando el control deslizante «más simple» (tal vez no del todo, pero lo que pensarías que sería el más simple) construido completamente usando un par de controles de etiqueta y un botón de comando.

Publicaré algunos artículos más en los próximos días que cubrirán otras posibilidades:

• Control deslizante de rango múltiple
• Control deslizante del navegador web heredado
• Control deslizante del navegador web moderno

Un control deslizante basado en VBA y formulario (de usuario)

La configuración básica

El código

Option Compare Database
Option Explicit

' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : 
' 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) - 
' 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  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  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

Con esta versión, puede hacer clic en el botón de comando y ajustar el control deslizante, o también puede hacer clic en cualquier parte del control deslizante para ajustar el valor. También puede ingresar el valor en el cuadro de texto y el control deslizante se ajustará automáticamente para representar el nuevo valor.

Base de datos de demostración

Siéntase libre de descargar una copia 100% desbloqueada de una base de datos de muestra que he reunido utilizando el enlace que se proporciona a continuación:

Descargar “Control deslizante: etiquetas y botones de comando”

SliderControl_VBA.zip – Descargado 139 veces – 32,87 KB

Aviso sobre contenido/descargas/demostraciones

Descargo de responsabilidad/Notas:

Si no tiene Microsoft Access, simplemente descargue e instale la versión de ejecución disponible gratuitamente (esto permite ejecutar bases de datos de MS Access, pero no modificar su diseño):

Tiempo de ejecución de Microsoft Access 2010
Tiempo de ejecución de Microsoft Access 2013
Tiempo de ejecución de Microsoft Access 2016
Tiempo de ejecución de Microsoft 365 Access

Una última palabra

Por último, dado que esto utiliza controles estándar y VBA, tenga en cuenta que también se puede implementar en UserForms. Por lo tanto, se puede implementar en Excel, Word, etc. ¡Esto no se limita a Access!