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 dispayed 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