我正在尝试寻找一种创建条形码的解决方案，最好是在 Excel 中，但不安装字体。我能找到的所有方法都告诉我安装字体。
我之所以不想使用新字体，是因为 Windows 的字体文件夹仅限于管理员使用。而且这是一台工作电脑，IT 部门从来不会批准任何东西。
有谁知道一种不需要安装的方法吗？我们可以使用 VBA 代码，因为它不受 IT 部门的限制。
答案1
有一种方法可以无需管理员权限安装自定义字体
然而雅科夫莱夫已经发布了很好的解决方案MrExcel论坛这将绘制条形码在您的工作表上，因此不需要字体
在 VBA IDE 中选择ThisWorkbook并粘贴以下函数
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
然后你可以用这样的函数绘制条形码
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
当然，您也可以将函数转换为 UDF，以便从公式中调用它。我已经在 Windows 10 上的 Excel 2016 上进行了测试，条形码阅读器可以完美读取输出
绘制条形码有多种替代方法：
- 具有条件格式的条形码生成器
- 带有 INDEX & MATCH 的条形码生成器来自 Max Vitzliputzli
- 带 VLOOKUP 的条形码大卫·巴拉奥纳
- Excel 中使用 OFFSET 的条形码来自 博科莫科
他们来自 Pete M.'s理解和创建 Excel 中的条形码或者你也可以观看Youtube 上的在线教程。您无需绘制对象，只需使列宽彼此相等，并将背景颜色设置为黑色以模拟条形。它们是 UPC 而不是 code128，但一旦您了解规则，就可以使用相同的原理来绘制 code128
在 UPC 中，数字由 7 位编码，如下所示
并且 1 在输出中将表示为黑色
这样你甚至不需要 VBA，因为一切都可以用纯 Excel 公式计算，但这会花费更多精力。结果也很大，但只需缩小或调整列的大小就可以了
答案2
您可以使用 Word 作为后台应用程序来生成条形码，而无需特殊的库或字体或大量代码。
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
答案3
您可以从 Excel 导出 CSV 文件并将其上传到某些在线服务以生成所需的条形码：