'计算EAN13校验位
Private Function Get_EAN_CheckSum(rawString As String)
Dim checkSum As Integer
checkSum = 0
For i = 2 To 12 Step 2
checkSum = checkSum + Val(Mid$(rawString, i, 1))
Next
checkSum = checkSum * 3
For i = 1 To 11 Step 2
checkSum = checkSum + Val(Mid$(rawString, i, 1))
Next
'函数返回值
Get_EAN_CheckSum = (10 - (checkSum Mod 10)) Mod 10
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'填充EAN码区边界
Private Function Fill_EAN_Bounds(ByVal x As Integer, ByVal y As Integer)
'初始化码区尺寸、背景色
For i = 1 To 100
Cells(y, x + i).ColumnWidth = 0.2
Cells(y, x + i).RowHeight = 100
Cells(y, x + i).Interior.ColorIndex = 0
Cells(y + 1, x + i).ColumnWidth = 0.2
Cells(y + 1, x + i).RowHeight = 20
Cells(y + 1, x + i).Interior.ColorIndex = 0
Next
'初始化码区左侧起始线
Cells(y, x + 1).Interior.ColorIndex = 1
Cells(y + 1, x + 1).Interior.ColorIndex = 1
Cells(y, x + 2).Interior.ColorIndex = 0
Cells(y + 1, x + 2).Interior.ColorIndex = 0
Cells(y, x + 3).Interior.ColorIndex = 1
Cells(y + 1, x + 3).Interior.ColorIndex = 1
'初始化码区中间线
Cells(y, x + 46).Interior.ColorIndex = 0
Cells(y + 1, x + 46).Interior.ColorIndex = 0
Cells(y, x + 47).Interior.ColorIndex = 1
Cells(y + 1, x + 47).Interior.ColorIndex = 1
Cells(y, x + 48).Interior.ColorIndex = 0
Cells(y + 1, x + 48).Interior.ColorIndex = 0
Cells(y, x + 49).Interior.ColorIndex = 1
Cells(y + 1, x + 49).Interior.ColorIndex = 1
Cells(y, x + 50).Interior.ColorIndex = 0
Cells(y + 1, x + 50).Interior.ColorIndex = 0
'初始化码区右侧终止线
Cells(y, x + 93).Interior.ColorIndex = 1
Cells(y + 1, x + 93).Interior.ColorIndex = 1
Cells(y, x + 94).Interior.ColorIndex = 0
Cells(y + 1, x + 94).Interior.ColorIndex = 0
Cells(y, x + 95).Interior.ColorIndex = 1
Cells(y + 1, x + 95).Interior.ColorIndex = 1
'函数返回值
Fill_EAN_Bounds = 0
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'填充EAN13条码线
Private Function Fill_EAN_Lines(ByVal x As Integer, ByVal y As Integer, ByVal n As Integer)
For i = 0 To 6
Cells(y, x + i).Interior.ColorIndex = IIf(n And (2 ^ (6 - i)), 1, 0)
Next
'函数返回值
Fill_EAN_Lines = 0
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'主过程
Private Sub worksheet_change(ByVal Target As Range)
'焦点不在目标区域则退出
If Target.Address <> "$A$1" Then
Exit Sub
End If
'初始化参量数组
Dim preModeCode, abModeCode, cModeCode
'前置码数组
preModeCode = Array(0, 11, 13, 14, 19, 25, 28, 21, 22, 26)
'AB模式数组
abModeCode = Array(Array(13, 25, 19, 61, 35, 49, 47, 59, 55, 11), Array(39, 51, 27, 33, 29, 57, 5, 17, 9, 23))
'C模式数组
cModeCode = Array(114, 102, 108, 66, 92, 78, 80, 68, 72, 116)
'获取输入的条码
Dim inText As String
inText = Range("$A$1").Text
'将输入的EAN13码拆分为输入码数组
ReDim inCode(0 To Len(inText) - 1)
For i = 0 To Len(inText) - 1
inCode(i) = Mid(inText, i + 1, 1)
Next
'计算校验位
Dim checkSum As Integer
checkSum = Get_EAN_CheckSum(inText)
'将校验位压入数组
inCode(Len(inText) - 1) = checkSum
'要绘制的坐标位置
Dim startX, startY As Integer
startX = 3
startY = 3
'绘制码区边界
Dim f, p, t, s As Integer
f = Fill_EAN_Bounds(startX, startY)
p = preModeCode(inCode(0))
For i = 0 To 5
t = IIf(p And (2 ^ (5 - i)), 1, 0)
s = Fill_EAN_Lines(4 + startX + 7 * i, startY, abModeCode(t)(inCode(i + 1)))
Next
For i = 6 To 11
s = Fill_EAN_Lines(9 + startX + 7 * i, startY, cModeCode(inCode(i + 1)))
Next
End Sub
|手机版|小黑屋|AUTOIT CN
( 鲁ICP备19019924号-1 )谷歌
百度
发表于 2020-6-12 17:20:30
发表于 2020-6-12 18:54:08
发表于 2020-6-27 11:12:01
.gif)