?
Solved

Create on-screen Keypad in Access VBA application

Posted on 2007-10-05
8
Medium Priority
?
931 Views
Last Modified: 2013-11-28
Hello

   What code will allow a keyboard emulation? I've writing a vba app that prompts the user to enter an amount. I want an on screen keypad to allow the entering of an amount. i would like the coded on screen keypad to enter the numbers selected as the physical keypad does. I have played with 'sendkeys' with not much luck...

Thank you
0
Comment
Question by:MichaelSwitzer
  • 2
  • 2
5 Comments
 
LVL 58

Accepted Solution

by:
Jim Dettman (Microsoft MVP/ EE MVE) earned 1000 total points
ID: 20024639

  That's straight forward enough.  I created an on-screen cash register by drawing a bunch of command buttons.  Then for the on click of each command button (shown below), executed logic based on the button pushed.

  For example on the the form, I had a button called cmdbtn114, with the on click of =RegisterBtnClick(114)

  114 would get looked up in a logic table.  In that table, I had the label to apply to the button, font size, and the function that was to be carried out in RegisterBtnClick.

HTH gets you started.  Bounce back with questions.

JimD

PS.  BTW this is very old code (A2 days).  It will still work, but not as clean as it should be

Private Function RegisterBtnClick(intButtonNumber As Integer) As Integer

  Const Routine = "RegisterBtnClick"
  Const Version = "1.0.0"

  Dim strSQL As String
  Dim strTemp As String
  Dim intGroupNumber
  Dim sglTemp
  Dim intTemp
 

' Decide which group button belongs to.
  If intButtonNumber > 99 Then
    intGroupNumber = 0
  Else
    intGroupNumber = Me![txtActiveGroup]
  End If
 
  strSQL = "[GroupID] = " & intGroupNumber & " AND [ButtonNumber] = " & intButtonNumber
  rstCRK.FindFirst strSQL
  If rstCRK.NoMatch Then
    GoTo Error_RegisterBtnClick
  Else

    Select Case rstCRK![Function]

    Case 1
    'PLU, value is item #, qty should have been entered.
    If Me![txtMsg] = "ITEM?" Then
        intTRItem = rstCRK![Value]
        rstInv.Seek "=", intTRItem
        If rstInv.NoMatch Then
            Call DisplayError
        Else
            strTRDescription = rstInv![ItemDescription]
            Me![txtDisplay] = rstInv![Sell]
            intTRTaxable = rstInv![Taxable]
            Me![txtMsg] = "AMT?"
        End If
    Else
        Call DisplayError
    End If
   
    Case 2
    'PLU, Popup lookup box for item.
    If Me![txtMsg] = "ITEM?" Then
        Me![txtPLU] = ""
        DoCmd.OpenForm "frmCRInvlupByItem", , , , , A_DIALOG
        If Me![txtPLU] <> "" Then
            intTRItem = Me![txtPLU]
            rstInv.Seek "=", intTRItem
            If rstInv.NoMatch Then
                Call DisplayError
            Else
                strTRDescription = rstInv![ItemDescription]
                Me![txtDisplay] = rstInv![Sell]
                intTRTaxable = rstInv![Taxable]
                Me![txtMsg] = "AMT?"
            End If
        End If
    Else
        Call DisplayError
    End If
   

    Case 3
    'PLU Catagory lookup, value is catagory ID.
    If Me![txtMsg] = "ITEM?" Then
        Me![txtPLU] = ""
        Me![txtCategory] = rstCRK![Value]
        DoCmd.OpenForm "frmCRInvlupByCategory", , , , , A_DIALOG
        If Me![txtPLU] <> "" Then
            intTRItem = Me![txtPLU]
            rstInv.Seek "=", intTRItem
            If rstInv.NoMatch Then
                Call DisplayError
            Else
                strTRDescription = rstInv![ItemDescription]
                Me![txtDisplay] = rstInv![Sell]
                intTRTaxable = rstInv![Taxable]
                Me![txtMsg] = "AMT?"
            End If
        End If
    Else
        Call DisplayError
    End If

    Case 4
    'Non taxable item, ask for $.
    If Me![txtMsg] = "ITEM?" Then
        intTRItem = -1
        strTRDescription = "Non Taxable Item"
        Me![txtDisplay] = "0.00"
        intTRTaxable = False
        Me![txtMsg] = "AMT?"
    Else
        Call DisplayError
    End If

    Case 5
    'Taxable item, ask for $.
    If Me![txtMsg] = "ITEM?" Then
        intTRItem = -2
        strTRDescription = "Taxable Item"
        Me![txtDisplay] = "0.00"
        intTRTaxable = True
        Me![txtMsg] = "AMT?"
    Else
        Call DisplayError
    End If

    Case 9
    ' Group change.  Call ChangeGroup.
    Me![txtActiveGroup] = rstCRK![Value]
    Call ChangeGroup

    Case 100
    ' Discount %
        If Me![txtMsg] = "AMT?" Then
            ' Save the Amount, prompt for discount.
            curTRAmount = Me![txtDisplay]
            Me![txtMsg] = "DIS%?"
            Me![txtDisplay] = 0
        Else
            Call DisplayError
        End If

    Case 101
    ' Discount $
        If Me![txtMsg] = "AMT?" Then
            ' Save the Amount, prompt for discount.
            curTRAmount = Me![txtDisplay]
            Me![txtMsg] = "DIS$?"
            Me![txtDisplay] = 0
        Else
            Call DisplayError
        End If

    Case 102
    ' Void Item
        If Me![txtMsg] = "QTY?" Then
            ' Ask line number
            gstrMBTitle = "VOID Line Item"
            gstrMBMsg = "Enter line item to void (leave blank to cancel)?"
            strTemp = InputBox$(gstrMBMsg, gstrMBTitle)
            If strTemp <> "" Then
                If IsNumeric(strTemp) Then
                    intTemp = CInt(strTemp)
                Else
                    intTemp = 0
                End If
   
                If intTemp > 0 And intTemp <= intLineCount Then
                    ' Flag item as void
                    rstTRD.Index = "PrimaryKey"
                    rstTRD.Seek "=", intTemp
                    If rstTRD.NoMatch Then
                        gstrMBMsg = "No such line item."
                        gintMBDef = MB_OK + MB_ICONSTOP
                        gintMBBeep = True
                        gintMBLog = False
                        Call DisplayMsgBox
                    Else
                        If (rstTRD!Taxable) Then
                           curSubTotalTax = curSubTotalTax - (rstTRD!LineTotal - rstTRD!Discount)
                        Else
                           curSubTotalNonTax = curSubTotalNonTax - (rstTRD!LineTotal - rstTRD!Discount)
                        End If
                       
                        Me![txtSubTotal] = curSubTotalNonTax + curSubTotalTax
                        Me![txtTaxTotal] = Round(curSubTotalTax * 0.07, 2)
                       
                        rstTRD.Edit
                        rstTRD!Void = True
                        rstTRD.Update

                    End If
                Else
                    gstrMBMsg = "No such line item."
                    gintMBDef = MB_OK + MB_ICONSTOP
                    gintMBBeep = True
                    gintMBLog = False
                    Call DisplayMsgBox
                End If
            End If
        Else
            Call DisplayError
        End If
           

    Case 103
    ' Void Sale
        If Me![txtMsg] = "QTY?" Then
            gstrMBTitle = "Confirm VOID sale"
            gstrMBMsg = "Are you sure you wish to void the sale?"
            gintMBDef = MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2
            gintMBBeep = True
            gintMBLog = False
            Call DisplayMsgBox
            If gintMBResp = IDYES Then
                ' Reset Journal file
                    Call ClearJournal
               
                ' Set the digit display and message.
                    Call ResetDisplay
           
                ' Reset the buttons
                    Call ChangeGroup
            End If
        Else
            Call DisplayError
        End If
   
    Case 104
    ' Total sale
        Me![txtSaleComplete] = False
        Me.Visible = False
        Forms![frmCRTotalSale].SetFocus
        Forms![frmCRTotalSale]![txtTotal].Requery
   
    Case 105
    ' Refund
   
    Case 106
    ' Clear digit
       Me![txtDisplay] = Fix(Me![txtDisplay] * 10) / 100
   
    Case 107
    ' Clear
      Me![txtDisplay] = "0.00"
   
    Case 108
    ' Clear ERR
        If Me![txtMsg] = "*ERR*" Then
            Me![txtMsg] = strLastTxtMsg
        Else
            Beep
        End If

    Case 110
    ' No Sale (Open Drawer)
    If intLineCount > 0 Then
        Call DisplayError
    Else
        Call OpenDrawer
    End If

    Case 200
    ' Digit Keypad
       Me![txtDisplay] = Me![txtDisplay] * 10
       Me![txtDisplay] = Me![txtDisplay] + (rstCRK![Value] / 100)
   
    Case 201
    ' 00 on keypad
       Me![txtDisplay] = Me![txtDisplay] * 100

    Case 202
    ' Enter on keypad
      If Me![txtMsg] = "QTY?" Then
        If Me![txtDisplay] = "0.00" Then
            Call DisplayError
        Else
            sngTRQty = Me![txtDisplay]
            Me![txtDisplay] = "0.00"
            Me![txtMsg] = "ITEM?"
        End If
      ElseIf Me![txtMsg] = "ITEM?" Then
        intTRItem = Fix(Me![txtDisplay])
        rstInv.Seek "=", intTRItem
        If rstInv.NoMatch Then
            Call DisplayError
        Else
            strTRDescription = rstInv![ItemDescription]
            Me![txtDisplay] = rstInv![Sell]
            intTRTaxable = rstInv![Taxable]
            Me![txtMsg] = "AMT?"
        End If
      ElseIf Me![txtMsg] = "AMT?" Then
        curTRAmount = Me![txtDisplay]
        Call WriteLineItem
      ElseIf Me![txtMsg] = "DIS$?" Then
        If Me![txtDisplay] <= curTRAmount Then
            curTRDiscount = Me![txtDisplay]
            Call WriteLineItem
        Else
            Beep
        End If
      ElseIf Me![txtMsg] = "DIS%?" Then
        If Me![txtDisplay] <= 100 Then
            curTRDiscount = Round((Me![txtDisplay] / 100) * curTRAmount, 2)
            Call WriteLineItem
        Else
            Beep
        End If
      Else
        Beep
      End If

    End Select
  End If


Exit_RegisterBtnClick:
    Exit Function

Error_RegisterBtnClick:
    UnexpectedError ModuleName, Routine, Version, Err, Error$
    Resume Exit_RegisterBtnClick

End Function
0
 
LVL 58
ID: 20024664

  I should have added that for button 114, the logic to be caried out was #200 (a digit) and the digit was the number "8".  In the function, that was handled by this section of code:

    Case 200
    ' Digit Keypad
       Me![txtDisplay] = Me![txtDisplay] * 10
       Me![txtDisplay] = Me![txtDisplay] + (rstCRK![Value] / 100)

  The format was for currency, which is why the /100.

JimD.

0
 
LVL 14

Expert Comment

by:ldunscombe
ID: 20027757
Create an unbound text box say text1

Create a command button for each keypad number and decimal point if required.

On click event for command 1
me.text1 = me.text1 & "1"

On click event for command 2
me.text1 = me.text1 & "2"

......
command button for clear Key
me.text1 = ""

command button for decimal point
'Prevent a user from entering more than 1 decimal point
if me.text1 like "*.*" then exit sub
me.text1 = me.text1 & "."
etc etc

then use the val(text1) function if you need to perform calculations
0
 
LVL 1

Author Comment

by:MichaelSwitzer
ID: 20027794
Idunscomb,

That is actually how I have it set up now, however, if the user moves the mouse to the beginning or middle of the value, the characters will still add only to the end.(or whatever static position specified in the code.)

Mike
0
 
LVL 14

Assisted Solution

by:ldunscombe
ldunscombe earned 1000 total points
ID: 20032538
Another way that might work for you,  May need some tweeking

In a module create a public varioable of type integer

Public cpos as integer

on your form in the mousemove event of the text box enter

'set cpos variable to the current cursor position
cpos = me.text1.selstart

in the onclick events for you command buttons try this

'Set the focus back to the text box
Me.Text1.SetFocus
'Set the cursor position to the previously recorded position
Me.Text1.SelStart = cpos
'insert the desired keystroke
SendKeys "1"

repeat for other command buttons

This way when ever a user clicks anywhere in the text box the variable cpos is set to the current cursor position and the command button puts it back there before the senkeys command.

Hope this helps
Regards Leigh
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Explore the ways to Unlock VBA Project Password Excel 2010 & 2013 documents. Go through the article and perform the steps carefully to remove VBA Excel .xls file.
Windows Explorer lets you open cabinet (cab) files like any other folder. In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.
This lesson discusses how to use a Mainform + Subforms in Microsoft Access to find and enter data for payments on orders. The sample data comes from a custom shop that builds and sells movable storage structures that are delivered to your property. …
With just a little bit of  SQL and VBA, many doors open to cool things like synchronize a list box to display data relevant to other information on a form.  If you have never written code or looked at an SQL statement before, no problem! ...  give i…

839 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question