条码扫描器在Excel中

现在我有一个Excel中的电子表格与一些VBA在其中作为我们的小企业库存数据库使用。 问题是我们正在成长，我需要变得更复杂。

扫描仪与用户窗体配合使用，文本框控件监视进入文本框的字符数。 当指定数量的字符被触发时，系统完成其工作。 我需要做的是监视来自扫描仪本身的input，而不使用文本框控件，这样我就可以设置多个扫描仪而不会相互干扰。

任何方向都非常感谢。

这里是代码：

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，虽然下面还没有完全testing，我记得它的工作; 但是有一些要求使其工作

在要遵循的代码中，当系统消息已经“达到峰值”并且以特定字符开始时，执行条形码读取。 大多数条形码阅读器可以通过编程以某种方式输出文本; 该代码需要添加一个不可见的前兆，通过msgMessage.wParam（代码示例案例17）和一个input字符来跟踪string来显示条形码读取完成并重置侦听器

对于您的条形码阅读器，您可能需要更改哪个字符是前缀，它与检测字符（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