纯VBA生成条形码

lxw6

VBA生成条形码的方式，常见的方法有：

1. 字体法（需要安装字体）
2. 控件法（需要引用第三方控件）
都不是很方便。既然二维码都可以纯代码生成。那条形码可以纯代码生成吗？答案是肯定的。生成的条形码可以很方便的用于商品管理、单据管理等领域。
下面是转贴，转自"Code128" barcode generator in VBA | MrExcel Message Board

亲测代码有效。代码如下：

1. <code>
   
2. Sub Code128Generate(ByVal X As Single, ByVal Y As Single, ByVal Height As Single, ByVal LineWeight As Single, _
   
3.                   ByRef TargetSheet As Worksheet, ByVal Content As String)
   
4. ' Supports B and C charsets only; values 00-94, 99,101, 103-105 for B, 00-101, 103-105 for C
   
5. ' X, Y - top-left corner coordinates
   
6. ' X in mm (0.376042)
   
7. ' Y in mm (0.341)
   
8. ' Height in mm
   
9. ' LineWeight in pt
   
10. 
    
11. Const Tbar_Symbol As String * 2 = "11" ' termination bar
    
12. Dim WeightSum As Single
    
13. Dim CurBar As Integer
    
14. Dim i, j, k, FirstSymbol As Integer
    
15. Dim tstr2 As String * 2
    
16. Dim tstr1 As String * 1
    
17. Dim ContentString As String ' bars sequence
    
18. 
    
19. Dim SymbolValue(0 To 106) As Integer ' values
    
20. Dim SymbolString(0 To 106) As String * 11 'bits sequence
    
21. Dim SymbolCharB(0 To 106) As String * 1  'Chars in B set
    
22. Dim SymbolCharC(0 To 106) As String * 2  'Chars in B set
    
23. 
    
24. For i = 0 To 106 ' values
    
25.     SymbolValue(i) = i
    
26. Next i
    
27. 
    
28. ' Symbols in charset B
    
29. For i = 0 To 94
    
30.     SymbolCharB(i) = Chr(i + 32)
    
31. Next i
    
32. 
    
33. ' Symbols in charset C
    
34. SymbolCharC(0) = "00"
    
35. SymbolCharC(1) = "01"
    
36. SymbolCharC(2) = "02"
    
37. SymbolCharC(3) = "03"
    
38. SymbolCharC(4) = "04"
    
39. SymbolCharC(5) = "05"
    
40. SymbolCharC(6) = "06"
    
41. SymbolCharC(7) = "07"
    
42. SymbolCharC(8) = "08"
    
43. SymbolCharC(9) = "09"
    
44. For i = 10 To 99
    
45.     SymbolCharC(i) = CStr(i)
    
46. Next i
    
47. 
    
48. ' bit sequences
    
49. SymbolString(0) = "11011001100"
    
50. SymbolString(1) = "11001101100"
    
51. SymbolString(2) = "11001100110"
    
52. SymbolString(3) = "10010011000"
    
53. SymbolString(4) = "10010001100"
    
54. SymbolString(5) = "10001001100"
    
55. SymbolString(6) = "10011001000"
    
56. SymbolString(7) = "10011000100"
    
57. SymbolString(8) = "10001100100"
    
58. SymbolString(9) = "11001001000"
    
59. SymbolString(10) = "11001000100"
    
60. SymbolString(11) = "11000100100"
    
61. SymbolString(12) = "10110011100"
    
62. SymbolString(13) = "10011011100"
    
63. SymbolString(14) = "10011001110"
    
64. SymbolString(15) = "10111001100"
    
65. SymbolString(16) = "10011101100"
    
66. SymbolString(17) = "10011100110"
    
67. SymbolString(18) = "11001110010"
    
68. SymbolString(19) = "11001011100"
    
69. SymbolString(20) = "11001001110"
    
70. SymbolString(21) = "11011100100"
    
71. SymbolString(22) = "11001110100"
    
72. SymbolString(23) = "11101101110"
    
73. SymbolString(24) = "11101001100"
    
74. SymbolString(25) = "11100101100"
    
75. SymbolString(26) = "11100100110"
    
76. SymbolString(27) = "11101100100"
    
77. SymbolString(28) = "11100110100"
    
78. SymbolString(29) = "11100110010"
    
79. SymbolString(30) = "11011011000"
    
80. SymbolString(31) = "11011000110"
    
81. SymbolString(32) = "11000110110"
    
82. SymbolString(33) = "10100011000"
    
83. SymbolString(34) = "10001011000"
    
84. SymbolString(35) = "10001000110"
    
85. SymbolString(36) = "10110001000"
    
86. SymbolString(37) = "10001101000"
    
87. SymbolString(38) = "10001100010"
    
88. SymbolString(39) = "11010001000"
    
89. SymbolString(40) = "11000101000"
    
90. SymbolString(41) = "11000100010"
    
91. SymbolString(42) = "10110111000"
    
92. SymbolString(43) = "10110001110"
    
93. SymbolString(44) = "10001101110"
    
94. SymbolString(45) = "10111011000"
    
95. SymbolString(46) = "10111000110"
    
96. SymbolString(47) = "10001110110"
    
97. SymbolString(48) = "11101110110"
    
98. SymbolString(49) = "11010001110"
    
99. SymbolString(50) = "11000101110"
    
100. SymbolString(51) = "11011101000"
     
101. SymbolString(52) = "11011100010"
     
102. SymbolString(53) = "11011101110"
     
103. SymbolString(54) = "11101011000"
     
104. SymbolString(55) = "11101000110"
     
105. SymbolString(56) = "11100010110"
     
106. SymbolString(57) = "11101101000"
     
107. SymbolString(58) = "11101100010"
     
108. SymbolString(59) = "11100011010"
     
109. SymbolString(60) = "11101111010"
     
110. SymbolString(61) = "11001000010"
     
111. SymbolString(62) = "11110001010"
     
112. SymbolString(63) = "10100110000"
     
113. SymbolString(64) = "10100001100"
     
114. SymbolString(65) = "10010110000"
     
115. SymbolString(66) = "10010000110"
     
116. SymbolString(67) = "10000101100"
     
117. SymbolString(68) = "10000100110"
     
118. SymbolString(69) = "10110010000"
     
119. SymbolString(70) = "10110000100"
     
120. SymbolString(71) = "10011010000"
     
121. SymbolString(72) = "10011000010"
     
122. SymbolString(73) = "10000110100"
     
123. SymbolString(74) = "10000110010"
     
124. SymbolString(75) = "11000010010"
     
125. SymbolString(76) = "11001010000"
     
126. SymbolString(77) = "11110111010"
     
127. SymbolString(78) = "11000010100"
     
128. SymbolString(79) = "10001111010"
     
129. SymbolString(80) = "10100111100"
     
130. SymbolString(81) = "10010111100"
     
131. SymbolString(82) = "10010011110"
     
132. SymbolString(83) = "10111100100"
     
133. SymbolString(84) = "10011110100"
     
134. SymbolString(85) = "10011110010"
     
135. SymbolString(86) = "11110100100"
     
136. SymbolString(87) = "11110010100"
     
137. SymbolString(88) = "11110010010"
     
138. SymbolString(89) = "11011011110"
     
139. SymbolString(90) = "11011110110"
     
140. SymbolString(91) = "11110110110"
     
141. SymbolString(92) = "10101111000"
     
142. SymbolString(93) = "10100011110"
     
143. SymbolString(94) = "10001011110"
     
144. SymbolString(95) = "10111101000"
     
145. SymbolString(96) = "10111100010"
     
146. SymbolString(97) = "11110101000"
     
147. SymbolString(98) = "11110100010"
     
148. SymbolString(99) = "10111011110"
     
149. SymbolString(100) = "10111101110"
     
150. SymbolString(101) = "11101011110"
     
151. SymbolString(102) = "11110101110"
     
152. SymbolString(103) = "11010000100"
     
153. SymbolString(104) = "11010010000"
     
154. SymbolString(105) = "11010011100"
     
155. SymbolString(106) = "11000111010"
     
156. 
     
157. X = X / 0.376042 'mm to pt
     
158. Y = Y / 0.341 'mm to pt
     
159. Height = Height / 0.341 'mm to pt
     
160. 
     
161. If IsNumeric(Content) = True Then  ' value is numeric
     
162.    i = 1 'symbol and weight index
     
163.    If Len(Content) Mod 2 = 1 Then 'odd
     
164.        WeightSum = SymbolValue(104) ' start-b
     
165.        ContentString = ContentString + SymbolString(104)
     
166.       tstr1 = Mid(Content, 1, 1)
     
167.       k = 0
     
168.       Do While tstr1 <> SymbolCharB(k)
     
169.          k = k + 1
     
170.       Loop
     
171.       WeightSum = WeightSum + i * SymbolValue(k)
     
172.       ContentString = ContentString + SymbolString(k)
     
173.       i = i + 1
     
174.       WeightSum = WeightSum + i * SymbolValue(99) 'Code-C
     
175.       ContentString = ContentString + SymbolString(99) 'Code-C
     
176.       Content = Right(Content, Len(Content) - 1) 'cut 1st symbol
     
177.    Else 'even
     
178.       WeightSum = SymbolValue(105) ' start-c
     
179.       ContentString = ContentString + SymbolString(105)
     
180.       i = 0
     
181.    End If
     
182.    
     
183.    For j = 1 To Len(Content) Step 2
     
184.       tstr2 = Mid(Content, j, 2)
     
185.       i = i + 1
     
186.       k = 0
     
187.       Do While tstr2 <> SymbolCharC(k)
     
188.          k = k + 1
     
189.       Loop
     
190.       WeightSum = WeightSum + i * SymbolValue(k)
     
191.       ContentString = ContentString + SymbolString(k)
     
192.    Next j
     
193.    ContentString = ContentString + SymbolString(SymbolValue(WeightSum Mod 103))
     
194.    ContentString = ContentString + SymbolString(106)
     
195. 
     
196.    
     
197.    Else ' alpha-numeric
     
198.    WeightSum = SymbolValue(104) ' start-b
     
199.    ContentString = ContentString + SymbolString(104)
     
200.    i = 0 ' symbol count
     
201.    For j = 1 To Len(Content) Step 1
     
202.       tstr1 = Mid(Content, j, 1)
     
203.       i = i + 1
     
204.       k = 0
     
205.       Do While tstr1 <> SymbolCharB(k)
     
206.          k = k + 1
     
207.       Loop
     
208.       WeightSum = WeightSum + i * SymbolValue(k)
     
209.       ContentString = ContentString + SymbolString(k)
     
210.    Next j
     
211.    ContentString = ContentString + SymbolString(SymbolValue(WeightSum Mod 103))
     
212.    ContentString = ContentString + SymbolString(106)
     
213. 
     
214. End If
     
215. 
     
216. ContentString = ContentString + Tbar_Symbol
     
217. 
     
218. 'Barcode drawing
     
219. CurBar = 0
     
220. 
     
221. For i = 1 To Len(ContentString)
     
222.     Select Case Mid(ContentString, i, 1)
     
223.     Case 0
     
224.         CurBar = CurBar + 1
     
225.     Case 1
     
226.         CurBar = CurBar + 1
     
227. ' (CurBar * LineWeight) * [B]0.9[/B] -  here is 10% overlapping :-)
     
228.         With TargetSheet.Shapes.AddLine(X + (CurBar * LineWeight) * 0.9, Y, X + (CurBar * LineWeight) * 0.9, (Y + Height)).Line
     
229.         .Weight = LineWeight
     
230.         .ForeColor.RGB = vbBlack ' my Excel writes light-blue lines by default, so the color is forcibly switched
     
231.         End With
     
232.     End Select
     
233. Next i
     
234. 
     
235. End Sub
     
236. </code>

复制代码

--------------------------------------------------------------------

ddmc

这个链接 的第6页 有更好的。

兰色的回忆

如二楼所说，第六页的确实更好用，楼主发的这个代码，生成的二维码都是一条条的细线，不是太实用，我整理了两个版本的代码，需要的人可以下载

YANWEI82123300

感谢兰色的回忆老师分享这个例子,应用非常广泛

luzwales

兰色的回忆 发表于 2022-9-2 09:16
如二楼所说，第六页的确实更好用，楼主发的这个代码，生成的二维码都是一条条的细线，不是太实用，我整理了 ...

怎么不能把这个写到函数里？ 我试了 好像不行， call 这个sub 好像不成功

gwjkkkkk

谢谢分享。。。

兰色的回忆

luzwales 发表于 2022-9-2 10:18
怎么不能把这个写到函数里？ 我试了 好像不行， call 这个sub 好像不成功

可以的啊，下载我的附件，里面有怎么用的代码，也可以参照下面的代码，在我电脑上运行没问题的
Call mainBarCoder("Hello World!", Range("A8"), 30, 10)

luzwales

兰色的回忆 发表于 2022-9-2 15:52
可以的啊，下载我的附件，里面有怎么用的代码，也可以参照下面的代码，在我电脑上运行没问题的
Call mai ...

我就用你的附件，不行啊！

兰色的回忆

luzwales 发表于 2022-9-2 16:30
我就用你的附件，不行啊！

你可以把你改的文件发上来，我看看怎么回事

luzwales

就在Function 块中调用这个 怎么不行呢？