Question

我可以使用什么样的控件，它是Access 2007+中的原生控件，可以自包含（不需要Active-X）以图形方式动态显示属性的比例，我可以：

加载时通过VBA设置其初始值;
将结果读回我的代码？

背景：

客户要我创建一个销售工具，用于各种销售人员的各种笔记本电脑，他们都使用某种版本的MS-Access。我无法控制该工具将被使用的环境。客户喜欢并希望Access是媒介，但不知道或不关心表是什么，他只是想要表格。

他的销售工具的一个方面是销售人员向客户展示具有和不具有某种属性的产品比例的方式。

假设我们正在销售小部件，我们会计算尺寸/重量等。我们需要的小部件，我们需要多少小部件，但我们还需要弄清楚这些小部件中有多少应该有特定的图片。

假设我们需要10个小部件，我需要一种方法让销售人员显示并动态更改有多少小部件有图片，有多少小部件没有，然后将这些信息读入发票和最终价格等内容。

对我来说，它听起来像一个滑动条（就像浏览器窗口一侧的滚动条），但我愿意接受选项。

加分：

在VBA中创建此控件的命令是什么？

Answer 1

您可以只放置一个文本框，然后允许上/下箭头键更改值。也可以在控件上方和下方放置一个按钮来向上/向下移动值。

说出这样的话：

是的，作为一般规则，您可能希望避免滑块控件，除非您有一些安装程序以确保滑块将安装在目标计算机上。但是，也许代替滑块，你可以像上面那样制作一个界面。（所以两次点击+100按钮会在框中加200）。

Answer 2

我在这里使用滑块控件。在滑块的OnChange事件中，将不可见的文本框设置为等于值：

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

然后，在驱动发票的查询的WHERE子句中使用该文本框值。

Answer 3

以下代码适用于Access 2016，但我还未能在2007年发布。如果有人能为我这样做，我可以肯定，我会很感激。

总而言之，我基本上在隐形标签下面堆叠了2个不同颜色的标签，并使用了点击事件。

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

如果你足够友好，可以在不同的环境中为我测试，请将它放在空数据库的空数据库中，运行它，查看“sliderForm”，然后尝试打破表单。你知道......想像推销员一样。

访问原生滑块控件？

3 个答案: