带有系统区域设置的Excel条码128:希伯来语

时间:2016-12-27 09:21:27

标签: excel-vba locale hebrew code128 vba

我正在使用Excel VBA模块来编码和计算BarCode 128和校验和(请参阅下面的代码)。 我正在使用Code 128 True Type字体在excel中显示条形码。

我的系统区域设置(在非unicode程序的区域设置中是希伯来语(无法更改) 结果条形码有一些未知的符号,因此无法读取。

  1. 有没有办法覆盖工作簿本身的系统区域设置(并使其与控制面板中的设置不同)?
  2. 有没有办法更改模块,以便它可以使用当前系统区域设置并对条形码进行编码,以便正确读取?
  3. 任何想法? 盖伊

    PS:我已将系统区域设置更改为英语并且其工作正常

    VBA模块:

    Option Explicit
    Public Function Code128(SourceString As String)
        'Written by Philip Treacy, Feb 2014
        'http://www.myonlinetraininghub.com/create-barcodes-with-excel-vba
        'This code is not guaranteed to be error free.  No warranty is implied or expressed. Use at your own risk and carry out your own testing
        'This function is governed by the GNU Lesser General Public License (GNU LGPL) Ver 3
        'Input Parameters : A string
        'Return : 1. An encoded string which produces a bar code when displayed using the CODE128.TTF font
        '         2. An empty string if the input parameter contains invalid characters
        Dim Counter As Integer
        Dim CheckSum As Long
        Dim mini As Integer
        Dim dummy As Integer
        Dim UseTableB As Boolean
        Dim Code128_Barcode As String
        If Len(SourceString) > 0 Then
            'Check for valid characters
            For Counter = 1 To Len(SourceString)
                Select Case Asc(Mid(SourceString, Counter, 1))
                    Case 32 To 126, 203
                    Case Else
                        MsgBox "Invalid character in barcode string." & vbCrLf & vbCrLf & "Please only use standard ASCII characters", vbCritical
                        Code128 = ""
                        Exit Function
                End Select
            Next
            Code128_Barcode = ""
            UseTableB = True
            Counter = 1
            Do While Counter <= Len(SourceString)
                If UseTableB Then
                    'Check if we can switch to Table C
                    mini = IIf(Counter = 1 Or Counter + 3 = Len(SourceString), 4, 6)
                    GoSub testnum
                    If mini% < 0 Then 'Use Table C
                        If Counter = 1 Then
                            Code128_Barcode = Chr(205)
                        Else 'Switch to table C
                            Code128_Barcode = Code128_Barcode & Chr(199)
                        End If
                        UseTableB = False
                    Else
                        If Counter = 1 Then Code128_Barcode = Chr(204) 'Starting with table B
                    End If
                End If
                If Not UseTableB Then
                    'We are using Table C, try to process 2 digits
                    mini% = 2
                    GoSub testnum
                    If mini% < 0 Then 'OK for 2 digits, process it
                        dummy% = Val(Mid(SourceString, Counter, 2))
                        dummy% = IIf(dummy% < 95, dummy% + 32, dummy% + 100)
                        Code128_Barcode = Code128_Barcode & Chr(dummy%)
                        Counter = Counter + 2
                    Else 'We haven't got 2 digits, switch to Table B
                        Code128_Barcode = Code128_Barcode & Chr(200)
                        UseTableB = True
                    End If
                End If
                If UseTableB Then
                    'Process 1 digit with table B
                    Code128_Barcode = Code128_Barcode & Mid(SourceString, Counter, 1)
                    Counter = Counter + 1
                End If
            Loop
            'Calculation of the checksum
            For Counter = 1 To Len(Code128_Barcode)
                dummy% = Asc(Mid(Code128_Barcode, Counter, 1))
                dummy% = IIf(dummy% < 127, dummy% - 32, dummy% - 100)
                If Counter = 1 Then CheckSum& = dummy%
                CheckSum& = (CheckSum& + (Counter - 1) * dummy%) Mod 103
            Next
            'Calculation of the checksum ASCII code
            CheckSum& = IIf(CheckSum& < 95, CheckSum& + 32, CheckSum& + 100)
            'Add the checksum and the STOP
            Code128_Barcode = Code128_Barcode & Chr(CheckSum&) & Chr$(206)
        End If
        Code128 = Code128_Barcode
        Exit Function
    testnum:
            'if the mini% characters from Counter are numeric, then mini%=0
            mini% = mini% - 1
            If Counter + mini% <= Len(SourceString) Then
                Do While mini% >= 0
                    If Asc(Mid(SourceString, Counter + mini%, 1)) < 48 Or Asc(Mid(SourceString, Counter + mini%, 1)) > 57 Then Exit Do
                    mini% = mini% - 1
                Loop
            End If
            Return
    End Function
    

    Per Atzmon的请求,这是一个包含两种语言环境设置的比较表:

    Comperison Table in both Locale Settings

0 个答案:

没有答案