3

I'm trying to find a solution to create barcodes, preferably in Excel but without installing a font. All the methods I can find tell me to install a font.

The reason I want it done without a new font is because the font folder of windows is limited to Administrator only. And it's a work computer with an IT department that never approves anything.

Does anyone know of a method that needs no installation? We can use VBA code since that is not restricted by IT department.

phuclv
  • 26,555
  • 15
  • 113
  • 235
Andreas
  • 260
  • 2
  • 14
  • 3
    You can embed a font into an excel sheet and by doing so, you do not need to install the font in other machines before it becomes usable. The only caveat is that you need to install the font in one pc and embed the font there. This could be done at home. – LPChip Jan 12 '18 at 13:13
  • 4
    You could recreate the font manually in Excel. Of course, you would have to be really bored or crazy to do that....But in all seriousness, if you *NEED* the font for work, there is no reason IT wont install a font, as it isnt a security risk. If they dont, go up the chain of command. – Keltari Jan 12 '18 at 13:19
  • @LPChip How would I do that. The font/workbook will mainly be used on one computer (at least initially) – Andreas Jan 12 '18 at 13:27
  • 1
    @Keltari You would think so wouldn't you? We recently started using Toyotas forklifters with their i_Site software. This means you can see how much each forklift is used and abused. This was decided at the top of the company. IT department refuses to install the client software. Their solution is that we should go and buy a new PC and a 3/4G internet connection. – Andreas Jan 12 '18 at 13:30
  • 2
    @Andreas https://www.microsofttraining.net/article-687-how-embed-fonts-in-excel.html – LPChip Jan 12 '18 at 13:48
  • @LPChip So I need to make the file at home where I embedd the font. Then use it here. Because I can't embed a font I can't use. – Andreas Jan 12 '18 at 14:25
  • Indeed. That's what you need to do. – LPChip Jan 12 '18 at 15:12
  • You can also use [ZXing.NET](https://github.com/micjahn/ZXing.Net/wiki/Using-ZXing.Net-with-VBA-%28COM-Interop%29) but I believe it would require a lot of setup and may require admin access – davidmneedham Jan 12 '18 at 15:39
  • 1
    @Keltari [fonts can be used to attack](https://security.stackexchange.com/q/91347/89181) there are many vulnerabilities in font renderer [like this](https://docs.microsoft.com/en-us/security-updates/securitybulletins/2015/ms15-010#windows-font-driver-denial-of-service-vulnerability---cve-2015-0060) and Windows allows to [block untrusted fonts](https://docs.microsoft.com/en-us/windows/threat-protection/block-untrusted-fonts-in-enterprise) – phuclv Jan 13 '18 at 13:00
  • @Andreas there are many ways that don't use a font but use an add-in [like this](https://www.tec-it.com/en/software/barcode-software/office/excel/Default.aspx) – phuclv Jan 13 '18 at 13:06
  • What I can't wrap my head around is that they they don't trust a font file but are okay with VBA??? Code128 is a very commonly used barcode format, so if your IT team doesn't trust anyone to find a trusted source for it, then there's no reason why they themselves wouldn't already have one they *do* trust on-hand (or -server) that they can deploy as needed; otherwise, tell them to earn their keep! – Arctiic May 29 '20 at 05:48
  • @Arctiic they don't care. All they care about is to make sure our daily work is barely possible. I have since this approached them with both free software and stuff I can develop for them that will save lots of money (I honestly believe about $100.000 yearly). Not interested. They even lock our business software so that we can't do our work in any other way than the slow and costly way, even though there are better, faster and free ways to do it better. – Andreas May 29 '20 at 07:56

3 Answers3

5

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:

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

UPC digit

and 1s will be represented as black in the output

UPC code sample

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

lockhrt
  • 121
  • 3
phuclv
  • 26,555
  • 15
  • 113
  • 235
  • This looks promising! I will give it a go in few hours, I'm on my way to a meeting right now. – Andreas Jan 15 '18 at 07:39
  • @Andreas, test the Code & post whether is working properly or not. – Rajesh Sinha Jan 15 '18 at 08:31
  • 2
    I got it working! It works fine. Made it a UDF and it will run as a worksheet function. It prints fine and can be scanned with our scanners. Perfect! – Andreas Jan 15 '18 at 11:20
2

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
phuclv
  • 26,555
  • 15
  • 113
  • 235
  • 2
    This code relies on there being a sheet named `Barcode` and a `RowLoc` variable defined elsewhere, but I tested it and it worked for me. – Engineer Toast Nov 11 '20 at 19:24
  • Edited the code into a more general format. @EngineerToast – Scott Cannon Nov 11 '20 at 20:01
  • 1
    great way. I've never known that Word 2013 and later support [DISPLAYBARCODE field](https://support.microsoft.com/en-us/office/field-codes-displaybarcode-6d81eade-762d-4b44-ae81-f9d3d9e07be3) – phuclv Nov 12 '20 at 01:39
  • only think I haven't been able to figure out is how to assign the image to a variable or array of variables instead of to the clipboard. – Scott Cannon Nov 12 '20 at 15:22
  • can I ask maybe a stupid question? how to implement that code to excel? I've just started with VBA and I can't get it to work – arclite Mar 20 '21 at 10:06
  • @arclite well first you have to enable the developer tab, then you need to have a way to trigger the code, generally I place a button on the excel sheet to trigger the function. the code is heavily commented to how it works. the image file that is created is copied into the clipboard then pasted with the last line into the excel workbook. – Scott Cannon Jun 02 '21 at 16:19
  • I no longer use the code however, because now I generate the barcodes in the spreadsheet and then reference the spreadsheet with a word document that produces the labels (with barcode images on them) in mailmerge. that was my goal in the first place to create shipping labels with barcodes on them for tracking. – Scott Cannon Jun 02 '21 at 16:34
0

You can export a CSV file from Excel and upload it to some online service to generate the requested barcode:

https://barcode.tec-it.com/en

phuclv
  • 26,555
  • 15
  • 113
  • 235
kappatech
  • 126
  • 4
  • 1
    That could work but I need to run it locally. We need to replace all barcodes in the warehouse and print them on a special printer along with information next to it. Using online versions like this means a lot of copy pastes needs to be done. Using Excel you can use formulas and stuff to get a good output directly. – Andreas Jan 12 '18 at 15:11