• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 953
  • Last Modified:

Create on-screen Keypad in Access VBA application

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
MichaelSwitzer
Asked:
MichaelSwitzer
  • 2
  • 2
2 Solutions
 
Jim Dettman (Microsoft MVP/ EE MVE)President / OwnerCommented:

  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
 
Jim Dettman (Microsoft MVP/ EE MVE)President / OwnerCommented:

  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
 
ldunscombeCommented:
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
 
MichaelSwitzerAuthor Commented:
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
 
ldunscombeCommented:
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now