Create code128 barcode without installing font?
There's a way to install custom fonts without admin rights
However yakovleff has posted a great solution in MrExcel forum which will draw the barcode on your sheet, hence no font is needed
Inside VBA IDE select ThisWorkbook and paste the following function
Sub Code128Generate_v2(ByVal X As Single, ByVal Y As Single, ByVal Height As Single, ByVal LineWeight As Single, _
ByRef TargetSheet As Worksheet, ByVal Content As String, Optional MaxWidth As Single = 0)
' Supports B and C charsets only; values 00-94, 99,101, 103-105 for B, 00-101, 103-105 for C
' X in mm (0.351)
' Y in mm (0.351) 1mm = 2.8 pt
' Height in mm
' LineWeight in pt
Dim WeightSum As Single
Const XmmTopt As Single = 0.351
Const YmmTopt As Single = 0.351
Const XCompRatio As Single = 0.9
Const Tbar_Symbol As String * 2 = "11"
Dim CurBar As Integer
Dim i, j, k, CharIndex, SymbolIndex As Integer
Dim tstr2 As String * 2
Dim tstr1 As String * 1
Dim ContentString As String ' bars sequence
Const Asw As String * 1 = "A" ' alpha switch
Const Dsw As String * 1 = "D" 'digital switch
Const Arrdim As Byte = 30
Dim Sw, PrevSw As String * 1 ' switch
Dim BlockIndex, BlockCount, DBlockMod2, DBlockLen As Byte
Dim BlockLen(Arrdim) As Byte
Dim BlockSw(Arrdim) As String * 1
Dim SymbolValue(0 To 106) As Integer ' values
Dim SymbolString(0 To 106) As String * 11 'bits sequence
Dim SymbolCharB(0 To 106) As String * 1 'Chars in B set
Dim SymbolCharC(0 To 106) As String * 2 'Chars in B set
For i = 0 To 106 ' values
SymbolValue(i) = i
Next i
' Symbols in charset B
For i = 0 To 94
SymbolCharB(i) = Chr(i + 32)
Next i
' Symbols in charset C
SymbolCharC(0) = "00"
SymbolCharC(1) = "01"
SymbolCharC(2) = "02"
SymbolCharC(3) = "03"
SymbolCharC(4) = "04"
SymbolCharC(5) = "05"
SymbolCharC(6) = "06"
SymbolCharC(7) = "07"
SymbolCharC(8) = "08"
SymbolCharC(9) = "09"
For i = 10 To 99
SymbolCharC(i) = CStr(i)
Next i
' bit sequences
SymbolString(0) = "11011001100"
SymbolString(1) = "11001101100"
SymbolString(2) = "11001100110"
SymbolString(3) = "10010011000"
SymbolString(4) = "10010001100"
SymbolString(5) = "10001001100"
SymbolString(6) = "10011001000"
SymbolString(7) = "10011000100"
SymbolString(8) = "10001100100"
SymbolString(9) = "11001001000"
SymbolString(10) = "11001000100"
SymbolString(11) = "11000100100"
SymbolString(12) = "10110011100"
SymbolString(13) = "10011011100"
SymbolString(14) = "10011001110"
SymbolString(15) = "10111001100"
SymbolString(16) = "10011101100"
SymbolString(17) = "10011100110"
SymbolString(18) = "11001110010"
SymbolString(19) = "11001011100"
SymbolString(20) = "11001001110"
SymbolString(21) = "11011100100"
SymbolString(22) = "11001110100"
SymbolString(23) = "11101101110"
SymbolString(24) = "11101001100"
SymbolString(25) = "11100101100"
SymbolString(26) = "11100100110"
SymbolString(27) = "11101100100"
SymbolString(28) = "11100110100"
SymbolString(29) = "11100110010"
SymbolString(30) = "11011011000"
SymbolString(31) = "11011000110"
SymbolString(32) = "11000110110"
SymbolString(33) = "10100011000"
SymbolString(34) = "10001011000"
SymbolString(35) = "10001000110"
SymbolString(36) = "10110001000"
SymbolString(37) = "10001101000"
SymbolString(38) = "10001100010"
SymbolString(39) = "11010001000"
SymbolString(40) = "11000101000"
SymbolString(41) = "11000100010"
SymbolString(42) = "10110111000"
SymbolString(43) = "10110001110"
SymbolString(44) = "10001101110"
SymbolString(45) = "10111011000"
SymbolString(46) = "10111000110"
SymbolString(47) = "10001110110"
SymbolString(48) = "11101110110"
SymbolString(49) = "11010001110"
SymbolString(50) = "11000101110"
SymbolString(51) = "11011101000"
SymbolString(52) = "11011100010"
SymbolString(53) = "11011101110"
SymbolString(54) = "11101011000"
SymbolString(55) = "11101000110"
SymbolString(56) = "11100010110"
SymbolString(57) = "11101101000"
SymbolString(58) = "11101100010"
SymbolString(59) = "11100011010"
SymbolString(60) = "11101111010"
SymbolString(61) = "11001000010"
SymbolString(62) = "11110001010"
SymbolString(63) = "10100110000"
SymbolString(64) = "10100001100"
SymbolString(65) = "10010110000"
SymbolString(66) = "10010000110"
SymbolString(67) = "10000101100"
SymbolString(68) = "10000100110"
SymbolString(69) = "10110010000"
SymbolString(70) = "10110000100"
SymbolString(71) = "10011010000"
SymbolString(72) = "10011000010"
SymbolString(73) = "10000110100"
SymbolString(74) = "10000110010"
SymbolString(75) = "11000010010"
SymbolString(76) = "11001010000"
SymbolString(77) = "11110111010"
SymbolString(78) = "11000010100"
SymbolString(79) = "10001111010"
SymbolString(80) = "10100111100"
SymbolString(81) = "10010111100"
SymbolString(82) = "10010011110"
SymbolString(83) = "10111100100"
SymbolString(84) = "10011110100"
SymbolString(85) = "10011110010"
SymbolString(86) = "11110100100"
SymbolString(87) = "11110010100"
SymbolString(88) = "11110010010"
SymbolString(89) = "11011011110"
SymbolString(90) = "11011110110"
SymbolString(91) = "11110110110"
SymbolString(92) = "10101111000"
SymbolString(93) = "10100011110"
SymbolString(94) = "10001011110"
SymbolString(95) = "10111101000"
SymbolString(96) = "10111100010"
SymbolString(97) = "11110101000"
SymbolString(98) = "11110100010"
SymbolString(99) = "10111011110"
SymbolString(100) = "10111101110"
SymbolString(101) = "11101011110"
SymbolString(102) = "11110101110"
SymbolString(103) = "11010000100"
SymbolString(104) = "11010010000"
SymbolString(105) = "11010011100"
SymbolString(106) = "11000111010"
X = X / XmmTopt 'mm to pt
Y = Y / YmmTopt 'mm to pt
Height = Height / YmmTopt 'mm to pt
If IsNumeric(Content) = True And Len(Content) Mod 2 = 0 Then 'numeric, mode C
WeightSum = SymbolValue(105) ' start-c
ContentString = ContentString + SymbolString(105)
i = 0 ' symbol count
For j = 1 To Len(Content) Step 2
tstr2 = Mid(Content, j, 2)
i = i + 1
k = 0
Do While tstr2 <> SymbolCharC(k)
k = k + 1
Loop
WeightSum = WeightSum + i * SymbolValue(k)
ContentString = ContentString + SymbolString(k)
Next j
ContentString = ContentString + SymbolString(SymbolValue(WeightSum Mod 103))
ContentString = ContentString + SymbolString(106)
ContentString = ContentString + Tbar_Symbol
Else ' alpha-numeric
' first digit
Select Case IsNumeric(Mid(Content, 1, 1))
Case Is = True 'digit
Sw = Dsw
Case Is = False 'alpha
Sw = Asw
End Select
BlockCount = 1
BlockSw(BlockCount) = Sw
BlockIndex = 1
BlockLen(BlockCount) = 1 'block length
i = 2 ' symbol index
Do While i <= Len(Content)
Select Case IsNumeric(Mid(Content, i, 1))
Case Is = True 'digit
Sw = Dsw
Case Is = False 'alpha
Sw = Asw
End Select
If Sw = BlockSw(BlockCount) Then
BlockLen(BlockCount) = BlockLen(BlockCount) + 1
Else
BlockCount = BlockCount + 1
BlockSw(BlockCount) = Sw
BlockLen(BlockCount) = 1
BlockIndex = BlockIndex + 1
End If
i = i + 1
Loop
'encoding
CharIndex = 1 'index of Content character
SymbolIndex = 0
For BlockIndex = 1 To BlockCount ' encoding by blocks
If BlockSw(BlockIndex) = Dsw And BlockLen(BlockIndex) >= 4 Then ' switch to C
Select Case BlockIndex
Case Is = 1
WeightSum = SymbolValue(105) ' Start-C
ContentString = ContentString + SymbolString(105)
Case Else
SymbolIndex = SymbolIndex + 1
WeightSum = WeightSum + SymbolIndex * SymbolValue(99) 'switch c
ContentString = ContentString + SymbolString(99)
End Select
PrevSw = Dsw
' encoding even amount of chars in a D block
DBlockMod2 = BlockLen(BlockIndex) Mod 2
If DBlockMod2 <> 0 Then 'even chars always to encode
DBlockLen = BlockLen(BlockIndex) - DBlockMod2
Else
DBlockLen = BlockLen(BlockIndex)
End If
For j = 1 To DBlockLen / 2 Step 1
tstr2 = Mid(Content, CharIndex, 2)
CharIndex = CharIndex + 2
SymbolIndex = SymbolIndex + 1
k = 0
Do While tstr2 <> SymbolCharC(k)
k = k + 1
Loop
WeightSum = WeightSum + SymbolIndex * SymbolValue(k)
ContentString = ContentString + SymbolString(k)
Next j
If DBlockMod2 <> 0 Then ' switch to B, encode 1 char
PrevSw = Asw
SymbolIndex = SymbolIndex + 1
WeightSum = WeightSum + SymbolIndex * SymbolValue(100) 'switch b
ContentString = ContentString + SymbolString(100)
'CharIndex = CharIndex + 1
SymbolIndex = SymbolIndex + 1
tstr1 = Mid(Content, CharIndex, 1)
k = 0
Do While tstr1 <> SymbolCharB(k)
k = k + 1
Loop
WeightSum = WeightSum + SymbolIndex * SymbolValue(k)
ContentString = ContentString + SymbolString(k)
CharIndex = CharIndex + 1 'this is a bug fix. Without it, it will add extra number after a longer digit block.
End If
Else 'alpha in B mode
Select Case BlockIndex
Case Is = 1
' PrevSw = Asw
WeightSum = SymbolValue(104) ' start-b
ContentString = ContentString + SymbolString(104)
Case Else
If PrevSw <> Asw Then
SymbolIndex = SymbolIndex + 1
WeightSum = WeightSum + SymbolIndex * SymbolValue(100) 'switch b
ContentString = ContentString + SymbolString(100)
End If
End Select
PrevSw = Asw
For j = CharIndex To CharIndex + BlockLen(BlockIndex) - 1 Step 1
tstr1 = Mid(Content, j, 1)
SymbolIndex = SymbolIndex + 1
k = 0
Do While tstr1 <> SymbolCharB(k)
k = k + 1
Loop
WeightSum = WeightSum + SymbolIndex * SymbolValue(k)
ContentString = ContentString + SymbolString(k)
Next j
CharIndex = j
End If
Next BlockIndex
ContentString = ContentString + SymbolString(SymbolValue(WeightSum Mod 103))
ContentString = ContentString + SymbolString(106)
ContentString = ContentString + Tbar_Symbol
End If
If MaxWidth > 0 And Len(ContentString) * LineWeight * XmmTopt > MaxWidth Then
LineWeight = MaxWidth / (Len(ContentString) * XmmTopt)
LineWeight = LineWeight / XCompRatio
End If
'Barcode drawing
CurBar = 0
For i = 1 To Len(ContentString)
Select Case Mid(ContentString, i, 1)
Case 0
CurBar = CurBar + 1
Case 1
CurBar = CurBar + 1
With TargetSheet.Shapes.AddLine(X + (CurBar * LineWeight) * XCompRatio, Y, X + (CurBar * LineWeight) * XCompRatio, (Y + Height)).Line
.Weight = LineWeight
.ForeColor.RGB = vbBlack
End With
End Select
Next i
End Sub
Then you can draw the barcode with a function like this
Sub test()
ThisWorkbook.ActiveSheet.Shapes.SelectAll
Selection.Delete
Code128Generate_v2 0, 5, 15, 1.5, ThisWorkbook.ActiveSheet, "0123456789ABCDEFGH", 90
Code128Generate_v2 154, 0, 8, 0.8, Worksheets("Template"), Worksheets("Template").Cells(2, 3).Value, 90
End Sub
Of course you can also convert the function to a UDF to call it from a formula. I've tested on Excel 2016 on Windows 10 and the output can be read perfectly by barcode readers
This is a sample from the author
There are many alternative ways to draw barcodes:
- Barcode generator with conditional formatting
- Barcode generator with INDEX & MATCH from Max Vitzliputzli
- Barcodes with VLOOKUP from David Barahona
- Barcodes in Excel with OFFSET from Boko Moko
They're from Pete M.'s Understanding and Creating Barcodes in Excel or you can also watch the online tutorial on Youtube. Instead of drawing objects you'll make the column widths equal to each other and set the background color to black to simulate the bar shape. They're UPC and not code128 but the same principle can be used to draw code128 once you know the rules
In UPC digits are encoded by 7 bits like this
and 1s will be represented as black in the output
This way you don't even need VBA because everything can be calculated in pure Excel formulas, but it'll take much more effort. The result is also huge, but just zoom out or resize the columns and you'll be fine
You can use Word as a background application to generate a barcode without special libraries or fonts or a ridiculously huge amount of code.
Dim ShapeName As String
Dim RowLoc as Integer
RowLoc = 1
Const BarcodeWidth As Integer = 175 'sets the image width too small will cut off the end of the barcode
Dim ws As Worksheet, WdApp
Set ws = ActiveSheet
Set WdApp = CreateObject("Word.Application")
ShapeName = ActiveSheet.Cells(RowLoc, 1) 'pulls the barcode number off the sheet used to generate the code and name the shape after it's on the page
With WdApp.Documents.Add
.PageSetup.RightMargin = .PageSetup.PageWidth - .PageSetup.LeftMargin - BarcodeWidth 'sets up the object
.Fields.Add(Range:=.Range, Type:=-1, Text:="DISPLAYBARCODE " & ShapeName & " CODE128 \d \t", PreserveFormatting:=False).Copy 'copies the barcode image into the clipboard
'.Fields.Add(Range:=.Range, Type:=-1, Text:="DISPLAYBARCODE " & ShapeName & " QR \q 3", PreserveFormatting:=False).Copy 'used if you want a QR code instead
End With
Sheets("Sheet1").Cells(RowLoc, 1).Select 'selects the location where the bar code will be pasted
ws.PasteSpecial Format:="Picture (Enhanced Metafile)", Link:=False, DisplayAsIcon:=False 'Pastes the bar code at the current selection