Hello All,
I've recently created a simple sub for Code 93 barcode drawing for a small project at my job. Want to share it with other Mr.Excel users and Google searchers.
Main features:
- Main symbology has been picked from CODE 93 SYMBOLOGY;
- The sub uses Shapes collection to draw lines of a barcode instead of special fonts;
- Sub draws a barcode onto a target Worksheet from beginning position which is defined by horizontal offset (X), vertical offset (Y) measured in mm of required height in mm; bar width is defined in pt;
Weaknesses/incompletenesses:
- Code contains main symbols only (values 0 to 46);
- If a symbol is out of the symbol list the sub ends without any message;
- Code does not check the length of the encoded string; if it is more that 20 chars a barcode is encoded wrongly.
- A complete barcode width is not pre-calulated and drawing begins from left which can cause unexpected overhangs;
- Sub does not support a barcode inclination; just vertical orientation
- Using Shapes collection increases a workbook size significantly.
- A barcode position is only correct when 100% print size is set.
- Obviously version-depended code (different versions/OSs/printers can vary the result, NOT tested).
Win 7 Ultimate, MS Office 2007 were used.
So, the main code is:
Barcode reading has been tested on an Android phone (Accusoft Barcode Scanner program) as well as on a PROTON IMS-3100 hardware wireless scanner.
Hope it would be of any help to anybody
Regards,
Yakovleff
I've recently created a simple sub for Code 93 barcode drawing for a small project at my job. Want to share it with other Mr.Excel users and Google searchers.
Main features:
- Main symbology has been picked from CODE 93 SYMBOLOGY;
- The sub uses Shapes collection to draw lines of a barcode instead of special fonts;
- Sub draws a barcode onto a target Worksheet from beginning position which is defined by horizontal offset (X), vertical offset (Y) measured in mm of required height in mm; bar width is defined in pt;
Weaknesses/incompletenesses:
- Code contains main symbols only (values 0 to 46);
- If a symbol is out of the symbol list the sub ends without any message;
- Code does not check the length of the encoded string; if it is more that 20 chars a barcode is encoded wrongly.
- A complete barcode width is not pre-calulated and drawing begins from left which can cause unexpected overhangs;
- Sub does not support a barcode inclination; just vertical orientation
- Using Shapes collection increases a workbook size significantly.
- A barcode position is only correct when 100% print size is set.
- Obviously version-depended code (different versions/OSs/printers can vary the result, NOT tested).
Win 7 Ultimate, MS Office 2007 were used.
So, the main code is:
Code:
Sub Code93Generate(ByVal X As Single, ByVal Y As Single, ByVal Height As Single, ByVal LineWeight As Single, TargetSheet As Worksheet, ByVal Content As String)
' X in mm
' Y in mm
' Height in mm
' LineWeight in pt
' Content = encoded string
Dim SSSymbol As String 'start/stop symbol
Const Tbar_Symbol As String = "1" 'termination bar
Dim CurBar As Integer ' current running bar in a barcode
Dim SymbolChar(0 To 46) As String * 1 'encoded characters
Dim SymbolValue(0 To 46) As Integer ' character values
Dim SymbolString(0 To 46) As String * 9 ' "bit" sequence for each character
Dim C_WeightSum As Single
Dim K_WeightSum As Single
Dim C_CheckSum As Integer 'C checksum
Dim K_CheckSum As Integer 'K checksum
Dim ContentString As String 'bit sequence of whole barcode to be drawed
Dim i, j, k As Integer 'cycles indexes
SSSymbol = "101011110"
For i = 0 To 46
SymbolValue(i) = i
Next i
For i = 0 To 9 'digits
SymbolChar(i) = i
Next i
For i = 10 To 35 'digits
SymbolChar(i) = Chr(i + 55)
Next i
SymbolChar(36) = "-"
SymbolChar(37) = "."
SymbolChar(38) = " "
SymbolChar(39) = "$"
SymbolChar(40) = "/"
SymbolChar(41) = "+"
SymbolChar(42) = "%"
SymbolChar(43) = "$"
SymbolChar(44) = "%"
SymbolChar(45) = "/"
SymbolChar(46) = "+"
SymbolString(0) = "100010100"
SymbolString(1) = "101001000"
SymbolString(2) = "101000100"
SymbolString(3) = "101000010"
SymbolString(4) = "100101000"
SymbolString(5) = "100100100"
SymbolString(6) = "100100010"
SymbolString(7) = "101010000"
SymbolString(8) = "100010010"
SymbolString(9) = "100001010"
SymbolString(10) = "110101000"
SymbolString(11) = "110100100"
SymbolString(12) = "110100010"
SymbolString(13) = "110010100"
SymbolString(14) = "110010010"
SymbolString(15) = "110001010"
SymbolString(16) = "101101000"
SymbolString(17) = "101100100"
SymbolString(18) = "101100010"
SymbolString(19) = "100110100"
SymbolString(20) = "100011010"
SymbolString(21) = "101011000"
SymbolString(22) = "101001100"
SymbolString(23) = "101000110"
SymbolString(24) = "100101100"
SymbolString(25) = "100010110"
SymbolString(26) = "110110100"
SymbolString(27) = "110110010"
SymbolString(28) = "110101100"
SymbolString(29) = "110100110"
SymbolString(30) = "110010110"
SymbolString(31) = "110011010"
SymbolString(32) = "101101100"
SymbolString(33) = "101100110"
SymbolString(34) = "100110110"
SymbolString(35) = "100111010"
SymbolString(36) = "100101110"
SymbolString(37) = "111010100"
SymbolString(38) = "111010010"
SymbolString(39) = "111001010"
SymbolString(40) = "101101110"
SymbolString(41) = "101110110"
SymbolString(42) = "110101110"
SymbolString(43) = "100100110"
SymbolString(44) = "111011010"
SymbolString(45) = "111010110"
SymbolString(46) = "100110010"
X = X / 0.376042 'mm to pt, measured by printing test lines onto an A4 page, can be different on each PC/printer.
Y = Y / 0.341 'mm to pt, measured by printing test lines onto an A4 page.
'Dont really know WHY X and Y factors are different, however they are...
Height = Height / 0.341 'mm to pt
Content = UCase(Content) ' UCase is used to make all symbols encodable
'C checksum counting
For i = 1 To Len(Content)
j = -1
Do ' searching for a character value
If j > 46 Then Exit Sub 'if an unlisted char is met exits Sub!
j = j + 1
Loop While Mid(Content, i, 1) <> SymbolChar(j)
C_WeightSum = C_WeightSum + SymbolValue(j) * (Len(Content) + 1 - i)
Next i
C_CheckSum = C_WeightSum Mod 47
Content = Content + SymbolChar(C_CheckSum)
'K checksum counting
For i = 1 To Len(Content)
j = -1
Do ' searching for a character value
j = j + 1
Loop While Mid(Content, i, 1) <> SymbolChar(j)
K_WeightSum = K_WeightSum + SymbolValue(j) * (Len(Content) + 1 - i)
Next i
K_CheckSum = K_WeightSum Mod 47
Content = Content + SymbolChar(K_CheckSum)
ContentString = SSSymbol
For i = 1 To Len(Content)
j = -1
Do ' searching for each symbol in a sequence
j = j + 1
Loop While Mid(Content, i, 1) <> SymbolChar(j)
ContentString = ContentString + SymbolString(j)
Next i
ContentString = ContentString + SSSymbol + Tbar_Symbol
'Barcode drawing
CurBar = 1
For i = 1 To Len(ContentString)
Select Case Mid(ContentString, i, 1)
Case 0
CurBar = CurBar + 1
Case 1
CurBar = CurBar + 1
TargetSheet.Shapes.AddLine X + CurBar * LineWeight, Y, X + CurBar * LineWeight, (Y + Height)
TargetSheet.Shapes(ActiveSheet.Shapes.Count).Line.Weight = LineWeight
TargetSheet.Shapes(ActiveSheet.Shapes.Count).Line.ForeColor.RGB = vbBlack ' each Excel version has its own default color so it is set forcibly
End Select
Next i
End SubBarcode reading has been tested on an Android phone (Accusoft Barcode Scanner program) as well as on a PROTON IMS-3100 hardware wireless scanner.
Hope it would be of any help to anybody
Regards,
Yakovleff
