我在excel visual basic中添加了一个函数,如下所示,它将字符串转换为条形码,从blog
获取 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
'Check for valid characters
For Counter = 1 To Len(SourceString)
Select Case Asc(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
'Check if we can switch to Table C
mini = IIf(Counter = 1 Or Counter + 3 = Len(SourceString), 4, 6)
GoSub testnum
If mini% < 0 Then 'Use Table C
If Counter = 1 Then
Code128_Barcode = Chr(205)
Else 'Switch to table C
Code128_Barcode = Code128_Barcode & Chr(199)
End If
UseTableB = False
Else
If Counter = 1 Then Code128_Barcode = Chr(204) 'Starting with table B
End If
End If
If Not UseTableB Then
'We are using Table C, try to process 2 digits
mini% = 2
GoSub testnum
If mini% < 0 Then 'OK for 2 digits, process it
dummy% = Val(Mid(SourceString, Counter, 2))
dummy% = IIf(dummy% < 95, dummy% + 32, dummy% + 100)
Code128_Barcode = Code128_Barcode & Chr(dummy%)
Counter = Counter + 2
Else 'We haven't got 2 digits, switch to Table B
Code128_Barcode = Code128_Barcode & Chr(200)
UseTableB = True
End If
End If
If UseTableB Then
'Process 1 digit with table B
Code128_Barcode = Code128_Barcode & Mid(SourceString, Counter, 1)
Counter = Counter + 1
End If
Loop
'Calculation of the checksum
For Counter = 1 To Len(Code128_Barcode)
dummy% = Asc(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
'Calculation of the checksum ASCII code
CheckSum& = IIf(CheckSum& < 95, CheckSum& + 32, CheckSum& + 100)
'Add the checksum and the STOP
Code128_Barcode = Code128_Barcode & Chr(CheckSum&) & Chr$(206)
End If
Code128 = Code128_Barcode
Exit Function
testnum:
'if the mini% characters from Counter are numeric, then mini%=0
mini% = mini% - 1
If Counter + mini% <= Len(SourceString) Then
Do While mini% >= 0
If Asc(Mid(SourceString, Counter + mini%, 1)) < 48 Or Asc(Mid(SourceString, Counter + mini%, 1)) > 57 Then Exit Do
mini% = mini% - 1
Loop
End If
Return
End Function
我需要在我创建的用于格式化单元格的宏中调用此函数。我是宏和vba函数的新手。现在我不知道如何在宏中调用这些函数并将列A传递给循环中的函数。所以A列中的所有值都转换为条形码
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintGridlines = True
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
For Each Target In Range(Cells(1, 1), Cells(65536, 1).End(xlUp))
If Target <> "" Then
With Range(Target, Target.Offset(0, 11))
.WrapText = True
End With
End If
Next
答案 0 :(得分:1)
我不完全确定你的意思&#34;将字体设置为Code128&#34;所以这是我最好的猜测
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintGridlines = True
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
For Each Target In Range("A1", Range("A" & Rows.Count).End(xlUp))
If Target.Value <> vbNullString Then
Target.Value = Code128(Target.Value)
Target.Resize(, 12).WrapText = True
End If
Next
答案 1 :(得分:0)
Application.WorksheetFunction.Code128(tempString)
确保Option Explicit位于您的函数顶部(如果您有Public函数,可能不需要,不确定)