Access native slider bar control?

Question

What form control can I use that is native in Access 2007+ that can be self-contained (not require Active-X) to dynamically display graphically the ratio of attribute, where I can:

1. Set its initial value through VBA upon load;
2. Read the result back into my code?

Background:

Client asked me to create a sales tool for use on the various laptops of his various salesmen, all of whom use some version of MS-Access. I don't have any control over the environment the tool will be used in. Client likes and wants Access to be the medium, but doesn't know or care what the tables are, he just wants forms.

One aspect of his sales tool is a way for the salesman to display to the customer the ratio of products with and without a certain attribute.

Say we are selling widgets, we figure out the size/weight/etc. widget we need, how many we need, but we also need to figure out how many of those widgets should have a certain picture on them.

Say we need 10 widgets, I need a way for the salesman to display and dynamically change how many widgets have the picture, and how many don't, and then read this information into things like the invoice and final price.

To me, it sounds like a slider bar (like the scroll bar on the side of your browser window), but I am open to options.

Bonus:

What is the command to create this control in VBA?

Answer 1

The below code works in Access 2016, but I haven't been able to text it in 2007 yet. If anyone can do that for me so I can be sure, I would appreciate it.

To summarize, I basically stacked 2 different colored labels underneath an invisible label, and used click events.

Option Explicit

Sub createsliderform()

    Dim slidernum, newformname, thisFormName As String
    Dim controlnum, i As Integer
    Dim thisform As Form
    Dim startheight, lngReturn As Long

substart:

    slidernum = 0
    slidernum = InputBox("Please enter the number of sliders you would like, from 1 to 22. " & vbNewLine & "(Forms can only be so tall.)")
    If slidernum = "" Then Exit Sub
    If Not isinteger(slidernum) Then MsgBox "Please enter only integers.": GoTo substart
    If slidernum > 22 Then MsgBox slidernum & " would make the form " & slidernum * 1440 & " twips tall, and Access 2016 only allows a form to be 31680 twips tall, maximum.": GoTo substart

    Dim myControls As Object
    Set myControls = CreateObject("Scripting.Dictionary")
    myControls.CompareMode = vbTextCompare
    controlnum = 0
    newformname = "sliderForm"

    Set thisform = CreateForm
    thisFormName = thisform.Name
    DoCmd.Close acForm, thisFormName, acSaveYes
    Set thisform = Nothing
    DoCmd.Rename newformname, acForm, thisFormName
    DoCmd.OpenForm newformname, acDesign
    Forms(newformname).Width = 6.5 * 1440
    Forms(newformname).Detail.Height = 0

    Forms(newformname).Module.InsertLines 3, "Sub sliderbar(Button As Integer, Shift As Integer, X As Single, Y As Single, thisform As String, thiscontrol As String, othercontrol As String, mytotalpossible As String)"
    Forms(newformname).Module.InsertLines 4, "Dim totalpossible As Integer"
    Forms(newformname).Module.InsertLines 5, "If isinteger(mytotalpossible) Then totalpossible = mytotalpossible Else totalpossible = 0"
    Forms(newformname).Module.InsertLines 6, "If X > Forms(thisform).Controls(thiscontrol).Width Then X = Forms(thisform).Controls(thiscontrol).Width"
    Forms(newformname).Module.InsertLines 7, "If X < 0 Then X = 0"
'I want to encourage all or nothing behavior giving the appearance of choice with the below. Obviously we could have it snap to location if we wanted.
    Forms(newformname).Module.InsertLines 8, "Forms(thisform).Controls(othercontrol).Width = X"
    Forms(newformname).Module.InsertLines 9, "Forms(thisform).Controls(thiscontrol).Caption = Round(totalpossible * Forms(thisform).Controls(othercontrol).Width / Forms(thisform).Controls(thiscontrol).Width) & "" of "" & totalpossible & "" widgets have pictures."""
    Forms(newformname).Module.InsertLines 10, "End Sub"

    For i = 1 To slidernum

        startheight = Forms(newformname).Detail.Height
        Forms(newformname).Detail.Height = Forms(newformname).Detail.Height + 1440

        Set myControls(controlnum) = CreateControl(newformname, acTextBox, acDetail, , , 0.2 * 1440, 0.3 * 1440 + startheight, 1 * 1440, 0.2 * 1440)
        controlnum = controlnum + 1

        Set myControls(controlnum) = CreateControl(newformname, acLabel, acDetail, , , 0.2 * 1440, 0.7 * 1440 + startheight, 3 * 1440, 0.2 * 1440)
        With myControls(controlnum)
            .BackStyle = 1
            .BackColor = RGB(207, 123, 121)
            .SpecialEffect = 2
        End With
        controlnum = controlnum + 1

        Set myControls(controlnum) = CreateControl(newformname, acLabel, acDetail, , , 0.2 * 1440, 0.7 * 1440 + startheight, 1.5 * 1440, 0.2 * 1440)
        With myControls(controlnum)
            .BackStyle = 1
            .BackColor = RGB(34, 177, 76)
            .SpecialEffect = 1
        End With
        controlnum = controlnum + 1

        Set myControls(controlnum) = CreateControl(newformname, acLabel, acDetail, , , 0.2 * 1440, 0.7 * 1440 + startheight, 3 * 1440, 0.2 * 1440)
        With myControls(controlnum)
            .BackStyle = 0
            .ForeColor = vbBlack
            .TextAlign = 2
            .Caption = "Choose an integer for the number of widgets."
        End With

        lngReturn = Forms(newformname).Module.CreateEventProc("Mousemove", Forms(newformname).Controls(myControls(controlnum).Name).Name)
        Forms(newformname).Module.InsertLines lngReturn + 1, "if button=1 then"
        Forms(newformname).Module.InsertLines lngReturn + 2, "Me." & myControls(controlnum - 3).Name & ".setfocus"
        Forms(newformname).Module.InsertLines lngReturn + 3, "sliderbar Button, Shift, X, Y, Me.Name, Me." & myControls(controlnum).Name & ".Name, Me." & myControls(controlnum - 1).Name & ".Name, Me." & myControls(controlnum - 3).Name & ".text"
        Forms(newformname).Module.InsertLines lngReturn + 4, "end if"

        lngReturn = Forms(newformname).Module.CreateEventProc("mouseup", Forms(newformname).Controls(myControls(controlnum).Name).Name)
        Forms(newformname).Module.InsertLines lngReturn + 1, "Me." & myControls(controlnum - 3).Name & ".setfocus"
        Forms(newformname).Module.InsertLines lngReturn + 2, "sliderbar Button, Shift, X, Y, Me.Name, Me." & myControls(controlnum).Name & ".Name, Me." & myControls(controlnum - 1).Name & ".Name, Me." & myControls(controlnum - 3).Name & ".text"

        lngReturn = Forms(newformname).Module.CreateEventProc("Change", Forms(newformname).Controls(myControls(controlnum - 3).Name).Name)
        Forms(newformname).Module.InsertLines lngReturn + 1, "If Me." & myControls(controlnum - 3).Name & ".Text = """" Or Not isinteger(Me." & myControls(controlnum - 3).Name & ".Text) Then totalpossible = 0 Else totalpossible = Me." & myControls(controlnum - 3).Name & ".Text"
        Forms(newformname).Module.InsertLines lngReturn + 2, "Me." & myControls(controlnum).Name & ".Caption = Round(totalpossible * Me." & myControls(controlnum - 1).Name & ".Width / Me." & myControls(controlnum).Name & ".Width) & "" of "" & totalpossible & "" widgets have pictures."""

        controlnum = controlnum + 1

        Set myControls(controlnum) = CreateControl(newformname, acLabel, acDetail, , , 1.25 * 1440, 0.3 * 1440 + startheight, 3 * 1440, 0.2 * 1440)
        myControls(controlnum).Caption = "<-- Enter the total amount of widgets here."
        controlnum = controlnum + 1

    Next i

        DoCmd.Close acForm, newformname, acSaveYes
        DoCmd.OpenForm newformname, acNormal

End Sub

Public Function isinteger(testme) As Boolean
    Dim mytest As Integer
    isinteger = False
    If Len(testme) = 0 Then Exit Function
    Err.Clear
    On Error Resume Next
    mytest = Int(testme)
    If Err.Number = 13 Then Exit Function
    On Error GoTo 0
    If Int(testme) - testme = 0 Then isinteger = True
End Function

If you are kind enough to test this in different environments for me, please put this in an empty module in an empty database, run it, look at the "sliderForm", and then try to break the form. You know... think like a salesman.

Answer 2

You could perhaps just place a text box and then allow the up/down arrow key to change the value. And also perhaps place a button above and below the control to up/down the value.

Say something like this:

And yes, as a general rule you likely want to avoid the slider control unless you have some installer to ensure that the slider will be installed on the target computer. However, perhaps in place of a slider, you cook up an interface like the above. (so two clicks on the +100 button would add 200 to the box).

Answer 3

I'd use a slider control here. In the OnChange event of the slider, set an invisible textbox equal to the value:

Private Sub MySlider_OnChange()
  Me.MyInvisibleTextbox.Text = MySlider.Value
End Sub

Then, use that textbox value in the WHERE clause of the query that drives the invoice.