vba生成Code128B码

happy886rr

胡乱写写，依然是vba控制单元格粗细呈现code128b码，很遗憾没能实现code128 auto，占地面积会大点。（仅支持WPS pro2016）

1. '计算CODE128校验位
   
2. Private Function Get_CODE128_CheckSum(rawString As String, idx As Object)
   
3. 
   
4.     Dim s As Integer
   
5.     s = 0
   
6. 
   
7.     For i = 1 To Len(rawString)
   
8.         s = s + idx(Mid$(rawString, i, 1)) * i
   
9.     Next
   
10. 
    
11.     '函数返回值
    
12.     Get_CODE128_CheckSum = (s + idx("StartB")) Mod 103
    
13. 
    
14. End Function
    
15. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
16. 
    
17. '填充CODE128码区边界
    
18. Private Function Fill_CODE128_Bounds(ByVal x As Integer, ByVal y As Integer)
    
19. 
    
20.     '初始化码区尺寸、背景色
    
21.     For i = 1 To 300
    
22.        Cells(y, x + i).ColumnWidth = 0.2
    
23.        Cells(y, x + i).RowHeight = 100
    
24.        Cells(y, x + i).Interior.ColorIndex = 0
    
25.     Next
    
26. End Function
    
27. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
28. 
    
29. 
    
30. '填充CODE128条码线
    
31. Private Function Fill_CODE128_Lines(ByVal x As Integer, ByVal y As Integer, ByVal m As Integer, rawString As String)
    
32. 
    
33.     Dim pOffSet As Integer
    
34.     pOffSet = 0
    
35. 
    
36.     For i = 1 To m
    
37.    
    
38.         For j = 0 To (Val(Mid$(rawString, i, 1)) - 1)
    
39.                 Cells(y, x + pOffSet + j).Interior.ColorIndex = (i Mod 2)
    
40.         Next j
    
41.         
    
42.         pOffSet = pOffSet + j
    
43.     Next i
    
44. 
    
45.     '函数返回值
    
46.     Fill_CODE128_Lines = 0
    
47. 
    
48. End Function
    
49. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
50. 
    
51. '主过程
    
52. Private Sub worksheet_change(ByVal Target As Range)
    
53. 
    
54.     'Append_EAN_Checksum焦点不在目标区域则退出
    
55.     If Target.Address <> "$A$1" Then
    
56.         Exit Sub
    
57.     End If
    
58.    
    
59.     '创建dic字典
    
60.     Dim dic As Object
    
61.     Set dic = CreateObject("Scripting.Dictionary")
    
62.    
    
63.     '初始化字典主键
    
64.     dic.Add " ", "212222"
    
65.     dic.Add "!", "222122"
    
66.     dic.Add """", "222221"
    
67.     dic.Add "#", "121223"
    
68.     dic.Add "$", "121322"
    
69.     dic.Add "%", "131222"
    
70.     dic.Add "&", "122213"
    
71.     dic.Add "'", "122312"
    
72.     dic.Add "(", "132212"
    
73.     dic.Add ")", "221213"
    
74.     dic.Add "*", "221312"
    
75.     dic.Add "+", "231212"
    
76.     dic.Add ",", "112232"
    
77.     dic.Add "-", "122132"
    
78.     dic.Add ".", "122231"
    
79.     dic.Add "/", "113222"
    
80.     dic.Add "0", "123122"
    
81.     dic.Add "1", "123221"
    
82.     dic.Add "2", "223211"
    
83.     dic.Add "3", "221132"
    
84.     dic.Add "4", "221231"
    
85.     dic.Add "5", "213212"
    
86.     dic.Add "6", "223112"
    
87.     dic.Add "7", "312131"
    
88.     dic.Add "8", "311222"
    
89.     dic.Add "9", "321122"
    
90.     dic.Add ":", "321221"
    
91.     dic.Add ";", "312212"
    
92.     dic.Add "<", "322112"
    
93.     dic.Add "=", "322211"
    
94.     dic.Add ">", "212123"
    
95.     dic.Add "?", "212321"
    
96.     dic.Add "@", "232121"
    
97.     dic.Add "A", "111323"
    
98.     dic.Add "B", "131123"
    
99.     dic.Add "C", "131321"
    
100.     dic.Add "D", "112313"
     
101.     dic.Add "E", "132113"
     
102.     dic.Add "F", "132311"
     
103.     dic.Add "G", "211313"
     
104.     dic.Add "H", "231113"
     
105.     dic.Add "I", "231311"
     
106.     dic.Add "J", "112133"
     
107.     dic.Add "K", "112331"
     
108.     dic.Add "L", "132131"
     
109.     dic.Add "M", "113123"
     
110.     dic.Add "N", "113321"
     
111.     dic.Add "O", "133121"
     
112.     dic.Add "P", "313121"
     
113.     dic.Add "Q", "211331"
     
114.     dic.Add "R", "231131"
     
115.     dic.Add "S", "213113"
     
116.     dic.Add "T", "213311"
     
117.     dic.Add "U", "213131"
     
118.     dic.Add "V", "311123"
     
119.     dic.Add "W", "311321"
     
120.     dic.Add "X", "331121"
     
121.     dic.Add "Y", "312113"
     
122.     dic.Add "Z", "312311"
     
123.     dic.Add "[", "332111"
     
124.     dic.Add "", "314111"
     
125.     dic.Add "]", "221411"
     
126.     dic.Add "^", "431111"
     
127.     dic.Add "_", "111224"
     
128.     dic.Add "`", "111422"
     
129.     dic.Add "a", "121124"
     
130.     dic.Add "b", "121421"
     
131.     dic.Add "c", "141122"
     
132.     dic.Add "d", "141221"
     
133.     dic.Add "e", "112214"
     
134.     dic.Add "f", "112412"
     
135.     dic.Add "g", "122114"
     
136.     dic.Add "h", "122411"
     
137.     dic.Add "i", "142112"
     
138.     dic.Add "j", "142211"
     
139.     dic.Add "k", "241211"
     
140.     dic.Add "l", "221114"
     
141.     dic.Add "m", "413111"
     
142.     dic.Add "n", "241112"
     
143.     dic.Add "o", "134111"
     
144.     dic.Add "p", "111242"
     
145.     dic.Add "q", "121142"
     
146.     dic.Add "r", "121241"
     
147.     dic.Add "s", "114212"
     
148.     dic.Add "t", "124112"
     
149.     dic.Add "u", "124211"
     
150.     dic.Add "v", "411212"
     
151.     dic.Add "w", "421112"
     
152.     dic.Add "x", "421211"
     
153.     dic.Add "y", "212141"
     
154.     dic.Add "z", "214121"
     
155.     dic.Add "{", "412121"
     
156.     dic.Add "|", "111143"
     
157.     dic.Add "}", "111341"
     
158.     dic.Add "~", "131141"
     
159.     dic.Add "DEL", "114113"
     
160.     dic.Add "FNC3", "114311"
     
161.     dic.Add "FNC2", "411113"
     
162.     dic.Add "SHIFT", "411311"
     
163.     dic.Add "CODEC", "113141"
     
164.     dic.Add "FNC4", "114131"
     
165.     dic.Add "CODEA", "311141"
     
166.     dic.Add "FNC1", "411131"
     
167.     dic.Add "StartA", "211412"
     
168.     dic.Add "StartB", "211214"
     
169.     dic.Add "StartC", "211232"
     
170.     dic.Add "Stop", "2331112"
     
171. 
     
172.     '创建dic字典索引idx
     
173.     Dim idx As Object
     
174.     Set idx = CreateObject("Scripting.Dictionary")
     
175.    
     
176.     '初始化字典主、索引
     
177.     idx.Add " ", "0"
     
178.     idx.Add "!", "1"
     
179.     idx.Add """", "2"
     
180.     idx.Add "#", "3"
     
181.     idx.Add "$", "4"
     
182.     idx.Add "%", "5"
     
183.     idx.Add "&", "6"
     
184.     idx.Add "'", "7"
     
185.     idx.Add "(", "8"
     
186.     idx.Add ")", "9"
     
187.     idx.Add "*", "10"
     
188.     idx.Add "+", "11"
     
189.     idx.Add ",", "12"
     
190.     idx.Add "-", "13"
     
191.     idx.Add ".", "14"
     
192.     idx.Add "/", "15"
     
193.     idx.Add "0", "16"
     
194.     idx.Add "1", "17"
     
195.     idx.Add "2", "18"
     
196.     idx.Add "3", "19"
     
197.     idx.Add "4", "20"
     
198.     idx.Add "5", "21"
     
199.     idx.Add "6", "22"
     
200.     idx.Add "7", "23"
     
201.     idx.Add "8", "24"
     
202.     idx.Add "9", "25"
     
203.     idx.Add ":", "26"
     
204.     idx.Add ";", "27"
     
205.     idx.Add "<", "28"
     
206.     idx.Add "=", "29"
     
207.     idx.Add ">", "30"
     
208.     idx.Add "?", "31"
     
209.     idx.Add "@", "32"
     
210.     idx.Add "A", "33"
     
211.     idx.Add "B", "34"
     
212.     idx.Add "C", "35"
     
213.     idx.Add "D", "36"
     
214.     idx.Add "E", "37"
     
215.     idx.Add "F", "38"
     
216.     idx.Add "G", "39"
     
217.     idx.Add "H", "40"
     
218.     idx.Add "I", "41"
     
219.     idx.Add "J", "42"
     
220.     idx.Add "K", "43"
     
221.     idx.Add "L", "44"
     
222.     idx.Add "M", "45"
     
223.     idx.Add "N", "46"
     
224.     idx.Add "O", "47"
     
225.     idx.Add "P", "48"
     
226.     idx.Add "Q", "49"
     
227.     idx.Add "R", "50"
     
228.     idx.Add "S", "51"
     
229.     idx.Add "T", "52"
     
230.     idx.Add "U", "53"
     
231.     idx.Add "V", "54"
     
232.     idx.Add "W", "55"
     
233.     idx.Add "X", "56"
     
234.     idx.Add "Y", "57"
     
235.     idx.Add "Z", "58"
     
236.     idx.Add "[", "59"
     
237.     idx.Add "", "60"
     
238.     idx.Add "]", "61"
     
239.     idx.Add "^", "62"
     
240.     idx.Add "_", "63"
     
241.     idx.Add "`", "64"
     
242.     idx.Add "a", "65"
     
243.     idx.Add "b", "66"
     
244.     idx.Add "c", "67"
     
245.     idx.Add "d", "68"
     
246.     idx.Add "e", "69"
     
247.     idx.Add "f", "70"
     
248.     idx.Add "g", "71"
     
249.     idx.Add "h", "72"
     
250.     idx.Add "i", "73"
     
251.     idx.Add "j", "74"
     
252.     idx.Add "k", "75"
     
253.     idx.Add "l", "76"
     
254.     idx.Add "m", "77"
     
255.     idx.Add "n", "78"
     
256.     idx.Add "o", "79"
     
257.     idx.Add "p", "80"
     
258.     idx.Add "q", "81"
     
259.     idx.Add "r", "82"
     
260.     idx.Add "s", "83"
     
261.     idx.Add "t", "84"
     
262.     idx.Add "u", "85"
     
263.     idx.Add "v", "86"
     
264.     idx.Add "w", "87"
     
265.     idx.Add "x", "88"
     
266.     idx.Add "y", "89"
     
267.     idx.Add "z", "90"
     
268.     idx.Add "{", "91"
     
269.     idx.Add "|", "92"
     
270.     idx.Add "}", "93"
     
271.     idx.Add "~", "94"
     
272.     idx.Add "DEL", "95"
     
273.     idx.Add "FNC3", "96"
     
274.     idx.Add "FNC2", "97"
     
275.     idx.Add "SHIFT", "98"
     
276.     idx.Add "CODEC", "99"
     
277.     idx.Add "FNC4", "100"
     
278.     idx.Add "CODEA", "101"
     
279.     idx.Add "FNC1", "102"
     
280.     idx.Add "StartA", "103"
     
281.     idx.Add "StartB", "104"
     
282.     idx.Add "StartC", "105"
     
283.     idx.Add "Stop", "106"
     
284.    
     
285.     '输入字符串
     
286.     Dim iStr As String
     
287.     iStr = Range("$A$1").Text
     
288.    
     
289.     '要绘制的坐标区域
     
290.     Dim x, y As Integer
     
291.     x = 2
     
292.     y = 3
     
293.    
     
294.     '调用CODE128绘线函数
     
295.     Dim ret, checkNum As Integer
     
296.    
     
297.     '初始化码区边界
     
298.     ret = Fill_CODE128_Bounds(x, y)
     
299.    
     
300.     '绘制开始符
     
301.     ret = Fill_CODE128_Lines(x, y, 6, dic("StartB"))
     
302.    
     
303.     '绘制数据位
     
304.     For i = 1 To Len(iStr)
     
305.         ret = Fill_CODE128_Lines(x + 11 * (i - 1) + 11, y, 6, dic(Mid$(iStr, i, 1)))
     
306.     Next
     
307.    
     
308.     '绘制校验符
     
309.     checkNum = Get_CODE128_CheckSum(iStr, idx)
     
310.     ret = Fill_CODE128_Lines(x + Len(iStr) * 11 + 11, y, 6, dic(Chr(checkNum + 32)))
     
311.    
     
312.     '绘制结束符
     
313.     ret = Fill_CODE128_Lines(x + Len(iStr) * 11 + 11 + 11, y, 7, dic("Stop"))
     
314. 
     
315. End Sub
     
316. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     

复制代码