excel - excel中的条码扫描器

Question

现在，我有一个 Excel 电子表格，其中包含一些 vba，可用作我们小型企业的库存数据库。问题是我们正在成长，我需要变得更加成熟。

扫描仪与带有文本框控件的用户窗体一起使用，该控件监视进入文本框的字符数。当触发指定数量的字符时，系统将完成其工作。我需要完成的是一种在不使用文本框控件的情况下监视来自扫描仪本身的输入的方法，这样我就可以设置多个扫描仪而不会相互干扰。

对此的任何方向都非常感谢。

这是代码:

Private Sub TextBox1_Change()
On Error GoTo endgame

Dim barCode As String
Dim charNumb As Long

    barCode = TextBox1.Text
    charNumb = Len(barCode)

    'This triggers the system to perform actions based on the barcode number   
    'received. All of my barcodes for this version are formatted to have only 5
    'characters. Works great with a single user and scanner.

    If charNumb = 5 Then

        Cells.Find(barCode).Activate
        ActiveCell.Offset(0, 1).Activate
        ActiveCell = ActiveCell + 1
        ActiveCell.Offset(0, 17).Activate
        ActiveCell = ActiveCell + 1

        If ActiveCell = ActiveCell.Offset(0, -1) Then

            ActiveCell.Offset(0, -1).Clear
            ActiveCell.Clear

            GoTo TIMESTAMPER

        Else
            GoTo TIMESTAMPER
        End If

        TIMESTAMPER:
        TextBox1.Text = ""

        'Timestamp
        ActiveCell.Offset(0, -5).Activate

        With ActiveCell
          .Formula = Now
          .NumberFormat = "m/d/yyyy h:mm:ss AM/PM"
        End With

        ActiveWorkbook.Save
        ActiveCell.EntireRow.Select
        TextBox1.SetFocus
    End If

    GoTo AllEndsWell

    endgame:

    Call errorsound

    AllEndsWell:

End Sub

Answer 1

我之前曾尝试将条形码阅读器支持添加到 Excel，虽然以下内容尚未经过全面测试，但我记得它正在工作；但是有一些要求才能使其工作

在接下来的代码中，当系统消息达到“峰值”并以特定字符开头时，将执行条形码读取。大多数条码阅读器都可以通过编程以某种方式输出文本；该代码需要将一个不可见的前导添加到通过 msgMessage.wParam 检测到的字符串(代码示例案例 17)和一个输入字符以跟随字符串以显示条形码读取何时完成并重置监听器

对于您的条形码阅读器，您可能需要更改前缀字符及其关联的检测字符(Ascii 值。即 17)

我当前的代码:

以下代码应放在类模块'KeyPressApi'中

Option Explicit

Private Type BARCODEBUFFER
    strBuf As String
    bCode As Boolean
End Type

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type MSG
    hwnd As Long
    Message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Private Declare Function WaitMessage Lib "user32" () As Long

Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" _
    (ByRef lpMsg As MSG, ByVal hwnd As Long, _
     ByVal wMsgFilterMin As Long, _
     ByVal wMsgFilterMax As Long, _
     ByVal wRemoveMsg As Long) As Long

Private Declare Function TranslateMessage Lib "user32" _
    (ByRef lpMsg As MSG) As Long

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
    (ByVal hwnd As Long, _
     ByVal wMsg As Long, _
     ByVal wParam As Long, _
     lParam As Any) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, _
     ByVal lpWindowName As String) As Long

Private Const WM_KEYDOWN As Long = &H100
Private Const PM_REMOVE  As Long = &H1
Private Const WM_CHAR    As Long = &H102
Private bExitLoop As Boolean
Private bufBuffer As BARCODEBUFFER

Public Event BarcodeRead(Barcode As String, ByRef Cancel As Boolean)

Public Sub StartKeyPressInit()
    Dim msgMessage As MSG
    Dim bCancel As Boolean
    Dim iMessage As Integer
    Dim iKeyCode As Integer
    Dim lXLhwnd As Long

    On Error GoTo errHandler
    Application.EnableCancelKey = xlErrorHandler
    bExitLoop = False 'Initialize boolean flag.
    lXLhwnd = FindWindow("XLMAIN", Application.Caption) 'Get the app hwnd.

    Do
        WaitMessage 'check for a key press and remove it from the msg queue.
        If PeekMessage(msgMessage, lXLhwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then
            iKeyCode = msgMessage.wParam 'store the virtual key code for later use.
            iMessage = msgMessage.Message

            TranslateMessage msgMessage 'translate the virtual key code into a char msg.
            PeekMessage msgMessage, lXLhwnd, WM_CHAR, WM_CHAR, PM_REMOVE

            bCancel = False
            Select Case iKeyCode 'Enter and backspace not handled correctly by below case statement
                Case 8 ' Backspace
                    If bufBuffer.bCode = True Then
                        If Len(bufBuffer.strBuf) > 0 Then
                            bufBuffer.strBuf = Left(bufBuffer.strBuf, Len(bufBuffer.strBuf) - 1)
                            bCancel = True
                        End If
                    End If
                Case 13 ' End of barcode string so reset to off mode
                    If bufBuffer.bCode = True Then
                        bufBuffer.bCode = False
                        RaiseEvent BarcodeRead(ReadBuffer(), 0)
                        bCancel = True
                    End If
                Case Else
            End Select

            Select Case msgMessage.wParam
                Case 17 ' Start of Barcode; Initialize buffer array
                    If bufBuffer.bCode = False Then
                        bufBuffer.bCode = True
                        bufBuffer.strBuf = ""
                        bCancel = True
                    End If
                Case Else ' All other data
                    If bufBuffer.bCode = True Then
                        If iKeyCode <> 0 Then
                            bufBuffer.strBuf = bufBuffer.strBuf & Chr(msgMessage.wParam)
                            bCancel = True
                        End If
                    End If
            End Select

            'if the key pressed is allowed post it to the application.
            If Not bCancel Then PostMessage lXLhwnd, iMessage, iKeyCode, 0
        End If

errHandler:     'Allow the processing of other msgs.
        DoEvents
    Loop Until bExitLoop
End Sub

Public Sub StopKeyPressWatch()
    bExitLoop = True 'Set this boolean flag to exit the above loop.
End Sub

Public Function ReadBuffer() As String
    ReadBuffer = bufBuffer.strBuf
    Dim i As Integer
    For i = 1 To 31
        ReadBuffer = Replace(ReadBuffer, Chr(i), "")
    Next
End Function

然后在要覆盖监听器的工作表中

Option Explicit

Dim WithEvents CKeyWatcher As KeyPressApi

Private Sub Worksheet_Activate()
    If CKeyWatcher Is Nothing Then Set CKeyWatcher = New KeyPressApi
    If Not CKeyWatcher Is Nothing Then CKeyWatcher.StartKeyPressInit
End Sub

Private Sub Worksheet_Deactivate()
    If Not CKeyWatcher Is Nothing Then CKeyWatcher.StopKeyPressWatch
End Sub

Private Sub CKeyWatcher_BarcodeRead(strBuffer As String, Cancel As Boolean)
    MsgBox strBuffer
End Sub