Yerel sürgü çubuğu kontrolüne erişim?

Question

O Erişim kendine yeten olabilir 2007+ yılında yerli kullanabilirsiniz hangi form denetimi (Aktif-X gerektirmeyen) dinamik olarak grafiksel ben yapabilirsiniz özniteliği oranını görüntülemek için:

1. başlangıç ​​Set yük ile VBA üzerinden değer;
2. Sonuç koduma geri dönüyor mu?

Geçmiş:

İstemci MS-Access bir versiyonunu kullanmak hepsi onun çeşitli pazarlamacı çeşitli dizüstü bilgisayarlarda kullanılmak üzere bir satış aracı oluşturmak istedi. Aletin kullanılacağı çevre üzerinde herhangi bir kontrole sahip değilim. İstemci hoşlanıyor ve ortama erişim istiyor ama masaların ne olduğunu bilmiyor ya da önemsemiyor, sadece form istiyor.

Satış aracının bir yönü, satıcının belirli bir özellik taşıyan ve içermeyen ürünlerin oranını müşteriye göstermesinin bir yoludur.

Widget sattığımızı varsayalım, boyut/ağırlık/vb. İhtiyacımız olan widget, kaç tane ihtiyacımız var, ancak bu widget'lardan kaçının üzerinde belirli bir resim olması gerektiğini de anlamaya ihtiyacımız var.

10 widget'a ihtiyaç duyduğumuzu söyleyeyim, satıcının görüntüde kaç tane widget bulunduğunu ve kaç tane görüntüyü dinamik olarak değiştireceğini ve sonra bu bilgiyi fatura ve son fiyat gibi şeylere okuyabileceğine ihtiyacım var.

Bana göre, bir kaydırma çubuğuna benziyor (tarayıcı pencerenizin yan tarafındaki kaydırma çubuğu gibi), ancak seçeneklere açıkım.

Bonus:

VBA bu denetimi oluşturmak için komut nedir?

Answer 1

Aşağıdaki kod Access 2016'da çalışır, ancak henüz 2007'de yazılamadım. Bunu benim için herkes yapabilirse, emin olabilirim, minnettar olurum.

Özetlemek gerekirse, temelde görünmez bir etiketin altında 2 farklı renkli etiket yığdım ve tıklama olaylarını kullandım.

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 

nezaketini benim için farklı ortamlarda bu test etmek ise, bunu çalıştırmak, boş bir veritabanındaki boş modülünde bu koymak "sliderForm" bakmak ve sonra formu kırmaya deneyin . Biliyorsun ... bir satıcı gibi düşün.

Answer 2

Burada bir kaydırma denetimi kullanmalıyım. fatura tahrik sorgunun WHERE ile bu metin kutusu değeri kullanmak, sonra

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

: sürgünün OnChange durumunda, değere eşit görünmez bir metin kutusu ayarlayın.

Answer 3

Belki de bir metin kutusu yerleştirebilir ve sonra yukarı/aşağı ok tuşunun değeri değiştirmesine izin verebilirsiniz. Ve belki de değerin yukarı/aşağı doğru kontrolün üstünde ve altında bir düğme yerleştirin.

böyle

şey söyle:

Ve evet, büyük olasılıkla size kaydırma hedef bilgisayarda yüklü olmasını sağlamak için bazı yükleyici yoksa kaydırıcı denetimini kaçınmak istiyorum genel bir kural olarak . Ancak, belki bir kaydırıcının yerine, yukarıdaki gibi bir arayüz hazırlarsınız. (bu yüzden +100 düğmesindeki iki tıklama kutuya 200 ekler).