Question

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

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

非常感谢任何方向。

以下是代码：

White  w = new White(Color.white);

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

excel中的条形码扫描仪

1 个答案: