指令：可以幫我寫一個轉換CODE 128的SUB ?
(事後小編承認問錯，FUNCTION 無誤)
以下是回饋，回想當年自幹一個CODE128的轉換，可是搞了一周阿。
AI：
Function Code128Text(str As String) As String
Dim i As Integer
Dim charCode As Integer
Dim checkSum As Integer
Dim checkDigit As Integer
Dim result As String
' Code128 起始符號B = 104
checkSum = 104
result = ""
For i = 1 To Len(str)
charCode = Asc(Mid(str, i, 1))
If charCode < 32 Or charCode > 126 Then
Code128Text = "轉換失敗"
Exit Function
End If
checkSum = (checkSum + (charCode - 32) * i) Mod 103
result = result & Mid(str, i, 1)
Next i
' 轉校驗碼到對應的ASCII字元
If checkSum < 95 Then
checkDigit = checkSum + 32
Else
checkDigit = checkSum + 100
End If
' 起始符號（Ì），資料本體，校驗字元，結束符號（Î）
Code128Text = Chr(204) & result & Chr(checkDigit) & Chr(206)
End Function
使用方式
在VBA模組貼上上方程式碼。
在Excel儲存格輸入＝Code128Text(A1) （假設A1是原資料）。
設定儲存格字型為支援Code 128的條碼字型（如IDAutomationC128）。
產生結果就可直接掃條碼。
放案二：
此函數支援Code 128B型（一般英文、數字、小部分符號），如果有特殊需求可以做進一步改寫。在Excel VBA中，可以用下列SUB（Function）將字串轉為Code 128對應的條碼資料（通常搭配已安裝的Code 128條碼字型使用），這段程式目前為Code 128B規則（常用於一般英文與數字）：
Function Code128Text(str As String) As String
Dim i As Integer
Dim charCode As Integer
Dim checkSum As Integer
Dim checkDigit As Integer
Dim result As String
' Code 128 起始碼B的數值
checkSum = 104
result = ""
For i = 1 To Len(str)
charCode = Asc(Mid(str, i, 1))
If charCode < 32 Or charCode > 126 Then
Code128Text = "轉換失敗"
Exit Function
End If
checkSum = (checkSum + (charCode - 32) * i) Mod 103
result = result & Mid(str, i, 1)
Next i
' 轉校驗碼到對應的ASCII字元
If checkSum < 95 Then
checkDigit = checkSum + 32
Else
checkDigit = checkSum + 100
End If
' 起始碼(Ì), 資料, 檢查碼, 結束碼(Î)
Code128Text = Chr(204) & result & Chr(checkDigit) & Chr(206)
End Function
將此Function貼到VBA模組，公式使用方式：
在工作表用 =Code128Text(A1)（A1為待轉字串），
讓該儲存格套用支援Code128的字型，
條碼即可列印、掃描。
放案三：
如需更完整Code 128自動切換字集、支援特殊編碼，可以考慮專用VBA浮水碼模組或外掛。可以，以下是一個VBA範例函數，能將一般字串轉換成Code 128（適用Code 128 B，字母、數字與常用符號）條碼字串，並給與起始碼與校驗碼與結束碼，需搭配專用Code 128條碼字型顯示：
Function Code128Text(str As String) As String
Dim i As Integer
Dim charCode As Integer
Dim checkSum As Integer
Dim checkDigit As Integer
Dim result As String
checkSum = 104 ' Code128 B起始符號
result = ""
For i = 1 To Len(str)
charCode = Asc(Mid(str, i, 1))
If charCode < 32 Or charCode > 126 Then
Code128Text = "轉換失敗"
Exit Function
End If
checkSum = (checkSum + (charCode - 32) * i) Mod 103
result = result & Mid(str, i, 1)
Next i
' 校驗值轉成Code128字元
If checkSum < 95 Then
checkDigit = checkSum + 32
Else
checkDigit = checkSum + 100
End If
Code128Text = Chr(204) & result & Chr(checkDigit) & Chr(206)
End Function
直接貼入VBA模組，並在Excel以 =Code128Text(A1) 方式使用，再請將儲存格的字型設為Code128專用條碼字型即可自動產生可掃描條碼。你可以直接用下列VBA Function把字串轉成Code 128（B組，適合一般英文、數字）。這種轉換須搭配安裝Code128條碼字型，產生符號後只要設該字型即可輸出正確條碼。
小編自己的多檔案處理方式：
想法：讀取檔案，整理在一張清單上，然後可以產生條碼給我，我好後續排版處理。
在工作表中作一個表單按鈕
在工作簿中新增一個"條碼"名稱的工作表
請記得安裝 CODE 128的字形檔案。
小編自己的範例檔案謝絕提供。
然後在VBA編輯畫面中，新增一個模組，貼上以下VBA。
Sub open_to_code128()
Application.DisplayAlerts = True
Sheets("條碼").Range("a:b").Clear
lastRow_S = Sheets("條碼").Cells(Sheets("條碼").Rows.Count, 1).End(xlUp).Row
Dim Data As Variant
ReDim Data(10000, 3)
Dim FILE_OPEN As FileDialog '宣告FILE_OPEN為檔案對話框
Set FILE_OPEN = Excel.Application.FileDialog(msoFileDialogFilePicker)
'設定FILE_OPEN為選取檔案功能
FILE_OPEN.InitialFileName = Excel.ActiveWorkbook.Path '對話框開始目錄的設定
FILE_OPEN.Filters.Add "Excel File", "*.xls*" '設定對話框要顯示的副檔名
FILE_OPEN.Filters.Add "所有檔案", "*.*"
FILE_OPEN.Show '顯示對話框
Add = 0
For I = 1 To FILE_OPEN.SelectedItems.Count
Source = Excel.ActiveWorkbook.Name '儲存目前作業中檔案名稱
FILE_OPEN_PATH = FILE_OPEN.SelectedItems(I) '取的檔案路徑
Workbooks.Open Filename:=FILE_OPEN_PATH '開啟案路徑
WORKNAME = Excel.ActiveWorkbook.Name '儲存新開檔案的檔案名稱
Windows(WORKNAME).Activate '啟用新開檔案的檔案名稱
lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
For X = 11 To lastRow Step 1 ''11是因為小編用的檔案資料在第11列開始的
TEMP = Code128Text(Sheets(1).Range("b" & X)) ''B是因為小編用的檔案資料在第B行開始的
temp2 = Sheets(1).Range("b" & X)
Data(Add, 0) = temp2
Data(Add, 1) = TEMP
Add = Add + 1
Next X
WORKNAME = Excel.ActiveWorkbook.Name
Windows(WORKNAME).Close
Windows(Source).Activate '啟用目前作業中檔案名稱
Next I
Sheets("條碼").Range("a1:b1") = Array("製造號碼", "製造條碼 ")
Sheets("條碼").Range("a2:b" & Add + 1) = Data
Sheets("條碼").Range("b2:b" & Add + 1).Font.Name = "Code 128"
End Sub
沒有留言:
張貼留言