轉貼/作法參考: https://www.exceldemy.com/code-128-barcode-font-for-excel/
STEP 1: Download Code 128 Font
- First of all, you need to download Code 128 You can download the font from this link.
- After that, extract the downloaded folder to the C:\Windows\Fonts folder.
- Otherwise, unzip the downloaded folder, copy the Code 128 font and paste it to the C:\Windows\Fonts folder.
- Also, select Continue if the administrator permissions window appears.
下載Code 128條碼字型,必須搭配Code128編碼後的文字使用。
STEP 2: Apply VBA Code
在Excel文件裡建立資料編碼的模組函式。
網頁中內文附的VBA程式碼貼過來使用,會發現之後產生出來的條碼刷不出來。後來發現是Unicode的關係,造成編碼內容錯誤。
VBA程式碼中
Chr() 要修正成 ChrW()
Asc() 要修正成 AscW()
修正後內容如下
Option Explicit
Public Function Code128(SourceString As String)
Dim Counter As Integer
Dim CheckSum As Long
Dim mini As Integer
Dim dummy As Integer
Dim UseTableB As Boolean
Dim Code128_Barcode As String
If Len(SourceString) > 0 Then
For Counter = 1 To Len(SourceString)
Select Case AscW(Mid(SourceString, Counter, 1))
Case 32 To 126, 203
Case Else
MsgBox "Invalid character in barcode string" & vbCrLf & vbCrLf & "Please only use standard ASCII characters", vbCritical
Code128 = ""
Exit Function
End Select
Next
Code128_Barcode = ""
UseTableB = True
Counter = 1
Do While Counter <= Len(SourceString)
If UseTableB Then
mini = IIf(Counter = 1 Or Counter + 3 = Len(SourceString), 4, 6)
GoSub testnum
If mini% < 0 Then
If Counter = 1 Then
Code128_Barcode = ChrW(205)
Else
Code128_Barcode = Code128_Barcode & ChrW(199)
End If
UseTableB = False
Else
If Counter = 1 Then Code128_Barcode = ChrW(204)
End If
End If
If Not UseTableB Then
mini% = 2
GoSub testnum
If mini% < 0 Then
dummy% = Val(Mid(SourceString, Counter, 2))
dummy% = IIf(dummy% < 95, dummy% + 32, dummy% + 100)
Code128_Barcode = Code128_Barcode & ChrW(dummy%)
Counter = Counter + 2
Else
Code128_Barcode = Code128_Barcode & ChrW(200)
UseTableB = True
End If
End If
If UseTableB Then
Code128_Barcode = Code128_Barcode & Mid(SourceString, Counter, 1)
Counter = Counter + 1
End If
Loop
For Counter = 1 To Len(Code128_Barcode)
dummy% = AscW(Mid(Code128_Barcode, Counter, 1))
dummy% = IIf(dummy% < 127, dummy% - 32, dummy% - 100)
If Counter = 1 Then CheckSum& = dummy%
CheckSum& = (CheckSum& + (Counter - 1) * dummy%) Mod 103
Next
CheckSum& = IIf(CheckSum& < 95, CheckSum& + 32, CheckSum& + 100)
Code128_Barcode = Code128_Barcode & ChrW(CheckSum&) & ChrW$(206)
End If
Code128 = Code128_Barcode
Exit Function
testnum:
mini% = mini% - 1
If Counter + mini% <= Len(SourceString) Then
Do While mini% >= 0
If AscW(Mid(SourceString, Counter + mini%, 1)) < 48 Or AscW(Mid(SourceString, Counter + mini%, 1)) > 57 Then Exit Do
mini% = mini% - 1
Loop
End If
Return
End Function
Public Function Code128(SourceString As String)
Dim Counter As Integer
Dim CheckSum As Long
Dim mini As Integer
Dim dummy As Integer
Dim UseTableB As Boolean
Dim Code128_Barcode As String
If Len(SourceString) > 0 Then
For Counter = 1 To Len(SourceString)
Select Case AscW(Mid(SourceString, Counter, 1))
Case 32 To 126, 203
Case Else
MsgBox "Invalid character in barcode string" & vbCrLf & vbCrLf & "Please only use standard ASCII characters", vbCritical
Code128 = ""
Exit Function
End Select
Next
Code128_Barcode = ""
UseTableB = True
Counter = 1
Do While Counter <= Len(SourceString)
If UseTableB Then
mini = IIf(Counter = 1 Or Counter + 3 = Len(SourceString), 4, 6)
GoSub testnum
If mini% < 0 Then
If Counter = 1 Then
Code128_Barcode = ChrW(205)
Else
Code128_Barcode = Code128_Barcode & ChrW(199)
End If
UseTableB = False
Else
If Counter = 1 Then Code128_Barcode = ChrW(204)
End If
End If
If Not UseTableB Then
mini% = 2
GoSub testnum
If mini% < 0 Then
dummy% = Val(Mid(SourceString, Counter, 2))
dummy% = IIf(dummy% < 95, dummy% + 32, dummy% + 100)
Code128_Barcode = Code128_Barcode & ChrW(dummy%)
Counter = Counter + 2
Else
Code128_Barcode = Code128_Barcode & ChrW(200)
UseTableB = True
End If
End If
If UseTableB Then
Code128_Barcode = Code128_Barcode & Mid(SourceString, Counter, 1)
Counter = Counter + 1
End If
Loop
For Counter = 1 To Len(Code128_Barcode)
dummy% = AscW(Mid(Code128_Barcode, Counter, 1))
dummy% = IIf(dummy% < 127, dummy% - 32, dummy% - 100)
If Counter = 1 Then CheckSum& = dummy%
CheckSum& = (CheckSum& + (Counter - 1) * dummy%) Mod 103
Next
CheckSum& = IIf(CheckSum& < 95, CheckSum& + 32, CheckSum& + 100)
Code128_Barcode = Code128_Barcode & ChrW(CheckSum&) & ChrW$(206)
End If
Code128 = Code128_Barcode
Exit Function
testnum:
mini% = mini% - 1
If Counter + mini% <= Len(SourceString) Then
Do While mini% >= 0
If AscW(Mid(SourceString, Counter + mini%, 1)) < 48 Or AscW(Mid(SourceString, Counter + mini%, 1)) > 57 Then Exit Do
mini% = mini% - 1
Loop
End If
Return
End Function
STEP 3: Use Code 128 Function
建立模組函式後,就可以在儲存格中使用。
Ex:
=Code128("ABCDEFG")
=Code128(A1)
使用函式後會得到Code128編碼後的字串
STEP 4: Change Font Theme and Size
針對Code128編碼後的文字更換為Code 128的字型(STEP 1下載安裝的字型)。
在字型下拉選項中可能找不到,可以手動輸入 Code 128 字型就會被套用。
進行到這個步驟Code 128條碼的部份就可以正確顯示出來了。
沒有留言:
張貼留言